home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / adared.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  97.4 KB  |  4,196 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.   */
  9. /* Reduce: This is the reduce action for ada. When called, the array
  10.    rh is created which contains pointers to the structures on the
  11.    top of the parse stack (prs_stack). To do this we traverse the 
  12.    stack. As this is happening, when we find a terminal on the stack,
  13.    we free the token structure for this terminal. After the traversal,
  14.    we then free all the structures on the top of the stack as indicated
  15.    by the length of the right hand side of the rule except one, which is
  16.    kept for reuse for the non-terminal being formed by the current reduction.
  17.    When we free the stack structures and the token structures, we have not
  18.    actually released the storage, but have put it back into a free pool
  19.    for reuse. However in this function we never allocate a stack or token
  20.    structure from our pool, so the data held in these structures remains
  21.    intact. A special case is when the right hand side of the rule has zero
  22.    symbols, when we instead allocate a new stack strucure and do not free
  23.    anything. */
  24.  
  25. #include "adared.h"
  26. #include "adalexprots.h"
  27. #include "reduceprots.h"
  28. #include "ppredefprots.h"
  29. #include "pspansprots.h"
  30. #include "prsutilprots.h"
  31. #include "errsprots.h"
  32. #include "adaredprots.h"
  33.  
  34.  
  35. #define TBSL
  36.  
  37. struct prsstack *rh[MAX_RHS];
  38. struct ast *id_node;
  39.  
  40. void reduce(int red)                                    /*;reduce*/
  41. {
  42.     int n = rhslen[red];
  43.     struct prsstack *tmp, *top;
  44.     struct ast *node;
  45.  
  46.     if (!n) {
  47.         tmp = PRSALLOC();
  48.         tmp->prev = prs_stack;
  49.         prs_stack = tmp;
  50.     }
  51.     else {
  52.         if (n == 1) {
  53.             rh[0] = prs_stack;
  54.         }
  55.         else {
  56.             top = prs_stack;
  57.             while (--n > 1) {
  58.                 rh[n] = prs_stack;
  59.                 prs_stack = prs_stack->prev;
  60.             }
  61.             rh[1] = tmp = prs_stack;
  62.             rh[0] = prs_stack = prs_stack->prev;
  63.             PRSFREE(top,tmp);
  64.         }
  65.     }
  66.  
  67.     if (redopt)
  68.         fprintf(errfile,"Rule %d [%d]\n",red + 1,rhslen[red]);
  69.     switch (red + 1) {
  70.  
  71.         /* pragma ::= 
  72.             PRAGMA identifier [(argument_association{,argument_association */
  73.     case 1 :
  74. #define id IND(1)
  75. #define arg_assoc_list_node AST(2)
  76.         {
  77.             struct two_pool *arg_assoc_list;
  78.             char *name_id;
  79.             int pragma_type = 0;
  80.  
  81.             arg_assoc_list = arg_assoc_list_node->links.list;
  82.             node = any_node;
  83.             if (!strcmp(namelist(id),"LIST")) {
  84.                 if (arg_assoc_list == NULL
  85.                   || arg_assoc_list->link != arg_assoc_list)
  86.                     prs_warning(LOC(0),LOC(3),
  87.                       "Pragma LIST takes one argument: ON or OFF");
  88.                 else
  89.                 {
  90.                     struct ast *arg;
  91.  
  92.                     arg = arg_assoc_list->link->val.node;
  93. #define opt_id ((arg->links.subast)[0])
  94. #define expression ((arg->links.subast)[1])
  95.                     if (opt_id != opt_node)
  96.                         prs_warning(LOC(0),LOC(3),
  97.                           "Named argument is invalid for pragma LIST");
  98.                     else if (expression->kind != AS_NAME)
  99.                         prs_warning(LOC(0),LOC(3),
  100.                           "Argument passed to pragma LIST is invalid");
  101.                     else {
  102.                         struct ast *name;
  103.  
  104.                         name = (expression->links.subast)[0];
  105.                         if (name->kind != AS_SIMPLE_NAME)
  106.                             prs_warning(LOC(0),LOC(3),
  107.                               "Name argument passed to pragma LIST is invalid");
  108.                         else {
  109.                             name_id = namelist(name->links.val);
  110.                             if (!strcmp(name_id,"ON"))
  111.                                 pragma_type = PRAGMA_LIST_ON;
  112.                             else if (!strcmp(name_id,"OFF"))
  113.                                 pragma_type = PRAGMA_LIST_OFF;
  114.                             else {
  115.                                 char msg[100];
  116.  
  117.                                 sprintf(msg,
  118.                 "Identifier %s is an invalid argument passed to pragma LIST",
  119.                                   name_id);
  120.                                 prs_warning(LOC(0),LOC(3),msg);
  121.                             }
  122.                         }
  123.                     }
  124.                 }
  125.                 if (!pragma_type)
  126.                     write_pragma(PRAGMA_LIST_ERR,LOC(0),LOC(3));
  127.             }
  128. #undef opt_id
  129. #undef expression
  130.             else if (!strcmp(namelist(id),"PAGE"))
  131.                 pragma_type = PRAGMA_PAGE;
  132.             else {
  133.                 struct two_pool *arg_assoc_list;
  134.                 struct ast *arg2_node,*name_node,*simple_name_node;
  135.  
  136.                 if (!strcmp(namelist(id),"IO_INTERFACE")) {
  137.                     arg_assoc_list = arg_assoc_list_node->links.list;
  138.                     /* get second argument of pragma io_interface and change
  139.                      * node from as_simple_name to as_line_no whose n_val
  140.                      * contains the internal number of the io routine
  141.                      * TBSL: this node kind should not be as_line_no, however
  142.                      * this avoids adding a new node kind for the moment!
  143.                      * The node we are changing is 2 levels down in the tree!
  144.                      */
  145.                     /* 2nd as_arg node*/
  146.                     arg2_node=arg_assoc_list->link->link->val.node;
  147.                     /* N_AST2(arg2_node) */
  148.                     name_node = arg2_node->links.subast[1];
  149.                     /*N_AST1(name_node)*/
  150.                     simple_name_node = name_node->links.subast[0];
  151.                     simple_name_node->kind = AS_LINE_NO;
  152.                     simple_name_node->links.val = 
  153.                       predef_code(namelist(simple_name_node->links.val));
  154.                 }
  155.                 NN(AS_PRAGMA);
  156.                 make_id(1);
  157.                 NAST2(id_node,arg_assoc_list_node);
  158.             }
  159.             if (pragma_type)
  160.                 write_pragma(pragma_type,LOC(0),LOC(3));
  161.         }
  162. #undef id
  163. #undef arg_assoc_list_node
  164.  
  165.         /* argument_association ::= [argument_identifier=>]expression */
  166.         /* case 2 : */
  167.  
  168.         /* basic_declaration ::= object_declaration */
  169.         /* case 3 : */
  170.  
  171.         /* basic_declaration ::= number_declaration */
  172.         /* case 4 : */
  173.  
  174.         /* basic_declaration ::= type_declaration */
  175.         /* case 5 : */
  176.  
  177.         /* basic_declaration ::= subtype_declaration */
  178.         /* case 6 : */
  179.  
  180.         /* basic_declaration ::= subprogram_declaration */
  181.         /* case 7 : */
  182.  
  183.         /* basic_declaration ::= package_declaration */
  184.         /* case 8 : */
  185.  
  186.         /* basic_declaration ::= task_declaration */
  187.         /* case 9 : */
  188.  
  189.         /* basic_declaration ::= generic_declaration */
  190.         /* case 10 : */
  191.  
  192.         /* basic_declaration ::= exception_declaration */
  193.         /* case 11 : */
  194.  
  195.         /* basic_declaration ::= generic_instantiation */
  196.         /* case 12 : */
  197.  
  198.         /* basic_declaration ::= renaming_declaration */
  199.         /* case 13 : */
  200.  
  201.         break;
  202.         /* object_declaration ::=
  203.              identifier_list : subtype_indication [:=expression */
  204.     case 14 :
  205. #define id_list AST(0)
  206. #define subtype_indic AST(2)
  207. #define opt_init AST(3)
  208.         NN(AS_OBJ_DECL);
  209.         NAST3(id_list,subtype_indic,opt_init);
  210. #undef id_list
  211. #undef subtype_indic
  212. #undef opt_init
  213.  
  214.         break;
  215.         /* object_declaration ::=
  216.             identifier_list : CONSTANT subtype_indication [:=e */
  217.     case 15 :
  218. #define id_list AST(0)
  219. #define subtype_indic AST(3)
  220. #define opt_init AST(4)
  221.         NN(AS_CONST_DECL);
  222.         NAST3(id_list,subtype_indic,opt_init);
  223. #undef id_list
  224. #undef subtype_indic
  225. #undef opt_init
  226.  
  227.         break;
  228.         /* object_declaration ::=
  229.             identifier_list : [CONSTANT] constrained_array_def */
  230.     case 16 :
  231. #define id_list AST(0)
  232. #define constant AST(2)
  233. #define array_def AST(3)
  234. #define opt_init AST(4)
  235.         NN((constant == opt_node) ? AS_OBJ_DECL : AS_CONST_DECL);
  236.         NAST3(id_list,array_def,opt_init);
  237. #undef id_list
  238. #undef constant
  239. #undef array_def
  240. #undef opt_init
  241.  
  242.         break;
  243.         /* number_declaration ::=
  244.             identifier_list : CONSTANT := universal_static_exp */
  245.     case 17 :
  246. #define id_list AST(0)
  247. #define expression AST(4)
  248.         NN(AS_NUM_DECL);
  249.         NAST2(id_list,expression);
  250. #undef id_list
  251. #undef expression
  252.  
  253.         break;
  254.         /* identifier_list ::= identifier {,identifier} */
  255.     case 18 :
  256.         node = AST(1);
  257.         make_id(0);
  258.         prepend(id_node,node);
  259.  
  260.         /* type_declaration ::= full_type_declaration */
  261.         /* case 19 : */
  262.  
  263.         /* type_declaration ::= incomplete_type_declaration */
  264.         /* case 20 : */
  265.  
  266.         /* type_declaration ::= private_type_declaration */
  267.         /* case 21 : */
  268.  
  269.         break;
  270.         /* full_type_declaration ::=
  271.             TYPE identifier [discriminant_part]IS type_defi */
  272.     case 22 :
  273. #define opt_discr AST(2)
  274. #define type_def AST(3)
  275.         make_id(1);
  276.         NN(AS_TYPE_DECL);
  277.         NAST3(id_node,opt_discr,type_def);
  278. #undef opt_discr
  279. #undef type_def
  280.  
  281.         /* type_definition ::= enumeration_type_definition */
  282.         /* case 23 : */
  283.  
  284.         /* type_definition ::= integer_type_definition */
  285.         /* case 24 : */
  286.  
  287.         /* type_definition ::= real_type_definition */
  288.         /* case 25 : */
  289.  
  290.         /* type_definition ::= array_type_definition */
  291.         /* case 26 : */
  292.  
  293.         /* type_definition ::= record_type_definition */
  294.         /* case 27 : */
  295.  
  296.         /* type_definition ::= access_type_definition */
  297.         /* case 28 : */
  298.  
  299.         /* type_definition ::= derived_type_definition */
  300.         /* case 29 : */
  301.  
  302.         break;
  303.         /* subtype_declaration ::= SUBTYPE identifier IS subtype_indication ; */
  304.     case 30 :
  305. #define subtype_indic AST(3)
  306.         make_id(1);
  307.         NN(AS_SUBTYPE_DECL);
  308.         NAST2(id_node,subtype_indic);
  309. #undef subtype_indic
  310.  
  311.         break;
  312.         /* subtype_indication ::= type_mark [constraint] */
  313.     case 31 :
  314. #define type_mark AST(0)
  315. #define opt_constraint AST(1)
  316.         NN(AS_SUBTYPE_INDIC);
  317.         NAST2(type_mark,opt_constraint);
  318. #undef type_mark
  319. #undef opt_constraint
  320.  
  321.         /* constraint ::= range_constraint */
  322.         /* case 32 : */
  323.  
  324.         /* constraint ::= floating_point_constraint */
  325.         /* case 33 : */
  326.  
  327.         /* constraint ::= fixed_point_constraint */
  328.         /* case 34 : */
  329.  
  330.         break;
  331.         /* constraint ::= general_aggregate */
  332.     case 35 : {
  333.             struct ast *element;
  334.             struct two_pool *new_list = NULL;
  335.  
  336.             node = AST(0);
  337.             node->kind = AS_CONSTRAINT;
  338.  
  339.             /* "Range" elements of the general_aggregate represent the
  340.              * constraints of an indexed-constrained array.  The base types
  341.              * of the constraints are left as optional in the AST and have to
  342.              * be resolved semantically by looking at the definition of the
  343.              * corresponding type_mark.  See the definition of
  344.              * "subtype_indication".
  345.              */
  346.             LLOOPTOP(node->links.list,tmp)
  347.                 if (tmp->val.node->kind == AS_RANGE) {
  348.                     element = new_node(AS_SUBTYPE);
  349.                     element->links.subast = new_ast2(opt_node,tmp->val.node);
  350.                 }
  351.                 else
  352.                     element = tmp->val.node;
  353.                 new_list = concatl(new_list,initlist(element));
  354.             LLOOPBOTTOM(tmp)
  355.             node->links.list = new_list;
  356.         }
  357.  
  358.         break;
  359.         /* derived_type_definition ::= NEW subtype_indication */
  360.     case 36 :
  361. #define subtype_indic AST(1)
  362.         NN(AS_DERIVED_TYPE);
  363.         NAST1(subtype_indic);
  364. #undef subtype_indic
  365.  
  366.         break;
  367.         /* range_constraint ::= RANGE range */
  368.     case 37 :
  369.         {
  370.             struct tok_loc *save_span;
  371.  
  372.             node = AST(1);
  373.             if (node->kind != AS_RANGE && node->kind != AS_RANGE_ATTRIBUTE) {
  374.                 syntax_err(SPAN(node),"Invalid range specification");
  375.                 save_span = get_left_span(node);
  376.                 node = opt_node;
  377.                 set_span(node, save_span);
  378.             }
  379.         }
  380.  
  381.         break;
  382.         /* range ::= range_attribute */
  383.     case 38 :
  384. #define name (node->links.subast)[0]
  385.         node = AST(0);
  386.         if (node->kind == AS_NAME) {
  387.             if (name->kind == AS_ATTRIBUTE) {
  388. #define attr_desig (name->links.subast)[0]
  389.                 if (attr_desig->links.val == RANGE_SYM) {
  390. #undef attr_desig
  391.                     struct ast *tmp;
  392.  
  393.                     tmp = name;
  394.                     astfree(node->links.subast);
  395.                     nodefree(node);
  396.                     node = tmp;
  397.                     node->kind = AS_RANGE_ATTRIBUTE;
  398.                 }
  399.             }
  400.             else
  401.                 node->kind = AS_RANGE_EXPRESSION;
  402.         }
  403. #undef name
  404.  
  405.         break;
  406.         /* range ::= simple_expression .. simple_expression */
  407.     case 39 :
  408. #define simple_expr1 AST(0)
  409. #define simple_expr2 AST(2)
  410.         NN(AS_RANGE);
  411.         NAST2(simple_expr1,simple_expr2);
  412. #undef simple_expr1
  413. #undef simple_expr2
  414.  
  415.         break;
  416.         /* enumeration_type_definition ::=
  417.             ( enumeration_literal_specification {,enu */
  418.     case 40 :
  419. #define enum_list AST(1)
  420.         node = AST(2);
  421.         prepend(enum_list,node);
  422.         node->kind = AS_ENUM;
  423. #undef enum_list
  424.  
  425.         /* enumeration_literal_specification ::= enumeration_literal */
  426.         /* case 41 : */
  427.  
  428.         break;
  429.         /* enumeration_literal ::= identifier */
  430.     case 42 :
  431. #define id IND(0)
  432.         NN(AS_SIMPLE_NAME);
  433.         node->links.val = id;
  434.         set_span(node,LOC(0));
  435. #undef id
  436.  
  437.         break;
  438.         /* enumeration_literal ::= character_literal */
  439.     case 43 :
  440. #define char_lit IND(0)
  441.         NN(AS_CHARACTER_LITERAL);
  442.         node->links.val = char_lit;
  443.         set_span(node,LOC(0));
  444. #undef char_lit
  445.  
  446.         break;
  447.         /* integer_type_definition ::= range_constraint */
  448.     case 44 :
  449. #define range_constraint AST(0)
  450.         NN(AS_INT_TYPE);
  451.         NAST1(range_constraint);
  452. #undef range_constraint
  453.  
  454.         break;
  455.         /* real_type_definition ::= floating_point_constraint */
  456.     case 45 :
  457. #define floating_point_constraint AST(0)
  458.         NN(AS_FLOAT_TYPE);
  459.         NAST1(floating_point_constraint);
  460. #undef floating_point_constraint
  461.  
  462.         break;
  463.         /* real_type_definition ::= fixed_point_constraint */
  464.     case 46 :
  465. #define fixed_point_constraint AST(0)
  466.         NN(AS_FIXED_TYPE);
  467.         NAST1(fixed_point_constraint);
  468. #undef fixed_point_constraint
  469.  
  470.         break;
  471.         /* floating_point_constraint ::=
  472.             floating_accuracy_definition [range_constra */
  473.     case 47 :
  474. #define opt_range_constraint AST(1)
  475.         node = AST(0);
  476.         (node->links.subast)[1] = opt_range_constraint;
  477. #undef opt_range_constraint
  478.  
  479.         break;
  480.         /* floating_accuracy_definition ::= DIGITS static_simple_expression */
  481.     case 48 :
  482. #define simple_expr AST(1)
  483.         NN(AS_DIGITS);
  484.         NAST2(simple_expr,any_node);
  485. #undef simple_expr
  486.  
  487.         break;
  488.         /* fixed_point_constraint ::=
  489.             fixed_accuracy_definition [range_constraint] */
  490.     case 49 :
  491. #define opt_range_constraint AST(1)
  492.         node = AST(0);
  493.         (node->links.subast)[1] = opt_range_constraint;
  494. #undef opt_range_constraint
  495.  
  496.         break;
  497.         /* fixed_accuracy_definition ::= DELTA static_simple_expression */
  498.     case 50 :
  499. #define simple_expr AST(1)
  500.         NN(AS_DELTA);
  501.         NAST2(simple_expr,any_node);
  502. #undef simple_expr
  503.  
  504.         /* array_type_definition ::= unconstrained_array_definition */
  505.         /* case 51 : */
  506.  
  507.         /* array_type_definition ::= constrained_array_definition */
  508.         /* case 52 : */
  509.  
  510.         break;
  511.         /* unconstrained_array_definition ::=
  512.             ARRAY ( index_subtype_definition {,ind */
  513.     case 53 :
  514. #define ndex AST(2)
  515. #define index_node AST(3)
  516. #define subtype_indic AST(6)
  517.         prepend(ndex,index_node);
  518.         NN(AS_ARRAY_TYPE);
  519.         NAST2(index_node,subtype_indic);
  520. #undef ndex
  521. #undef index_node
  522. #undef subtype_indic
  523.  
  524.         break;
  525.         /* constrained_array_definition ::=
  526.             ARRAY index_constraint OF component_subt */
  527.     case 54 :
  528. #define index_constraint AST(1)
  529. #define subtype_indic AST(3)
  530.         NN(AS_ARRAY_TYPE);
  531.         NAST2(index_constraint,subtype_indic);
  532. #undef index_constraint
  533. #undef subtype_indic
  534.  
  535.         break;
  536.         /* index_subtype_definition ::= name RANGE <> */
  537.     case 55 :
  538. #define name AST(0)
  539.         if (!check_expanded_name(name))
  540.             syntax_err(SPAN(name),
  541.                 "Invalid type_mark used in index_subtype_definition");
  542.         NN(AS_BOX);
  543.         NAST1(name);
  544. #undef name
  545.  
  546.         break;
  547.         /* index_constraint ::= ( discrete_range {,discrete_range} ) */
  548.     case 56 :
  549. #define discrete_range AST(1)
  550.         node = AST(2);
  551.         prepend(discrete_range,node);
  552.         LLOOPTOP(node->links.list,tmp)
  553.             check_discrete_range(tmp->val.node);
  554.         LLOOPBOTTOM(tmp)
  555. #undef discrete_range
  556.  
  557.             break;
  558.         /* discrete_range ::= name range_constraint */
  559.     case 57 :
  560. #define name AST(0)
  561. #define range_constraint AST(1)
  562.         if (!check_expanded_name(name))
  563.             syntax_err(SPAN(name),
  564.               "Discrete_subtype_indication must be a type_mark");
  565.         NN(AS_SUBTYPE);
  566.         NAST2(name,range_constraint);
  567. #undef name
  568. #undef range_constraint
  569.  
  570.         break;
  571.         /* discrete_range ::= range */
  572.     case 58 :
  573. #define ast_range AST(0)
  574.         if (ast_range->kind == AS_RANGE) {
  575.             NN(AS_SUBTYPE);
  576.             NAST2(opt_node,ast_range);
  577.         }
  578.         else
  579.             node = ast_range;
  580. #undef ast_range
  581.  
  582.         break;
  583.         /* record_type_definition ::= RECORD component_list END RECORD */
  584.     case 59 :
  585. #define component_list AST(1)
  586.         NN(AS_RECORD);
  587.         NAST1(component_list);
  588. #undef component_list
  589.  
  590.         break;
  591.         /* component_list ::=
  592.             {pragma} {component_declaration} component_declaration */
  593.     case 60 :
  594. #define pragma_node1 AST(0)
  595. #define comp_dec_node AST(1)
  596. #define comp_dec AST(2)
  597. #define pragma_node2 AST(3)
  598.         check_pragmas(pragma_node1,null_pragmas);
  599.         check_pragmas(pragma_node2,null_pragmas);
  600.         comp_dec_node->links.list = concatl3(pragma_node1->links.list,
  601.           comp_dec_node->links.list,initlist(comp_dec));
  602.         NN(AS_COMPONENT_LIST);
  603.         NAST3(comp_dec_node,opt_node,pragma_node2);
  604.         nodefree(pragma_node1);
  605. #undef pragma_node1
  606. #undef comp_dec_node
  607. #undef comp_dec
  608. #undef pragma_node2
  609.  
  610.         break;
  611.         /* component_list ::=
  612.             {pragma} {component_declaration} variant_part {pragma} */
  613.     case 61 :
  614. #define pragma_node1 AST(0)
  615. #define comp_dec_node AST(1)
  616. #define variant_part AST(2)
  617. #define pragma_node2 AST(3)
  618.         check_pragmas(pragma_node1,null_pragmas);
  619.         check_pragmas(pragma_node2,null_pragmas);
  620.         comp_dec_node->links.list = concatl(pragma_node1->links.list,
  621.           comp_dec_node->links.list);
  622.         NN(AS_COMPONENT_LIST);
  623.         NAST3(comp_dec_node,variant_part,pragma_node2);
  624.         nodefree(pragma_node1);
  625. #undef pragma_node1
  626. #undef comp_dec_node
  627. #undef variant_part
  628. #undef pragma_node2
  629.  
  630.         break;
  631.         /* component_list ::= {pragma} NULL ; {pragma} */
  632.     case 62 :
  633. #define pragma_node1 AST(0)
  634. #define pragma_node2 AST(3)
  635.         pragma_node1->links.list = concatl(pragma_node1->links.list,
  636.           pragma_node2->links.list);
  637.         check_pragmas(pragma_node1,null_pragmas);
  638.         NN(AS_COMPONENT_LIST);
  639.         NAST3(opt_node,opt_node,pragma_node1);
  640.         nodefree(pragma_node2);
  641. #undef pragma_node1
  642. #undef pragma_node2
  643.  
  644.         break;
  645.         /* component_declaration ::=
  646.             identifier_list : component_subtype_definition  */
  647.     case 63 :
  648. #define id_list AST(0)
  649. #define subtype_indic AST(2)
  650. #define opt_init AST(3)
  651.         NN(AS_FIELD);
  652.         NAST3(id_list,subtype_indic,opt_init);
  653. #undef id_list
  654. #undef subtype_indic
  655. #undef opt_init
  656.  
  657.         break;
  658.         /* discriminant_part ::=
  659.             ( discriminant_specification {;discriminant_specifi */
  660.     case 64 :
  661. #define discr_spec AST(1)
  662.         node = AST(2);
  663.         prepend(discr_spec,node);
  664. #undef discr_spec
  665.  
  666.         break;
  667.         /* discriminant_specification ::=
  668.             identifier_list : type_mark [:=expression] */
  669.     case 65 :
  670. #define id_list AST(0)
  671. #define type_mark AST(2)
  672. #define opt_init AST(3)
  673.         NN(AS_DISCR_SPEC);
  674.         NAST3(id_list,type_mark,opt_init);
  675. #undef id_list
  676. #undef type_mark
  677. #undef opt_init
  678.  
  679.         break;
  680.         /* variant_part ::=
  681.             CASE discriminant_simple_name IS {pragma} variant {varia */
  682.     case 66 :
  683. #define simple_name AST(1)
  684. #define pragma_node AST(3)
  685. #define variant AST(4)
  686. #define variant_node AST(5)
  687.         check_pragmas(pragma_node,null_pragmas);
  688.         variant_node->links.list = concatl3(pragma_node->links.list,
  689.           initlist(variant),variant_node->links.list);
  690.         check_choices(variant_node,"a variant_part");
  691.         NN(AS_VARIANT_DECL);
  692.         NAST2(simple_name,variant_node);
  693.         nodefree(pragma_node);
  694. #undef simple_name
  695. #undef pragma_node
  696. #undef variant
  697. #undef variant_node
  698.  
  699.         break;
  700.         /* variant ::= WHEN choice {|choice} => component_list */
  701.     case 67 :
  702. #define choice AST(1)
  703. #define choice_node AST(2)
  704. #define component_list AST(4)
  705.         prepend(choice,choice_node);
  706.         NN(AS_VARIANT_CHOICES);
  707.         NAST2(choice_node,component_list);
  708. #undef choice
  709. #undef choice_node
  710. #undef component_list
  711.  
  712.         break;
  713.         /* choice ::= discrete_range */
  714.     case 68 :
  715. #define discrete_range AST(0)
  716.         switch(discrete_range->kind) {
  717.         case AS_SUBTYPE :
  718.         case AS_RANGE_ATTRIBUTE :
  719.             NN(AS_RANGE_CHOICE);
  720.             NAST1(discrete_range);
  721.             break;
  722.         case AS_RANGE_EXPRESSION :
  723.             node = discrete_range;
  724.             node->kind = AS_CHOICE_UNRESOLVED;
  725.             break;
  726.         default :
  727.             NN(AS_SIMPLE_CHOICE);
  728.             NAST1(discrete_range);
  729.             break;
  730.         }
  731. #undef discrete_range
  732.  
  733.         break;
  734.         /* choice ::= OTHERS */
  735.     case 69 :
  736.         {
  737.             struct ast *span_node;
  738.  
  739.             NN(AS_OTHERS_CHOICE);
  740.             span_node = new_node(AS_SIMPLE_NAME);
  741.             span_node->links.val = IND(0);
  742.             set_span(span_node,LOC(0));
  743.             NAST3(opt_node,opt_node,span_node);
  744.         }
  745.  
  746.         break;
  747.         /* access_type_definition ::= ACCESS subtype_indication */
  748.     case 70 :
  749. #define subtype_indic AST(1)
  750.         NN(AS_ACCESS_TYPE);
  751.         NAST1(subtype_indic);
  752. #undef subtype_indic
  753.  
  754.         break;
  755.         /* incomplete_type_declaration ::=
  756.             TYPE identifier [discriminant_part]; */
  757.     case 71 :
  758. #define opt_discr_part AST(2)
  759.         make_id(1);
  760.         NN(AS_INCOMPLETE_DECL);
  761.         NAST2(id_node,opt_discr_part);
  762. #undef opt_discr_part
  763.  
  764.         break;
  765.         /* declarative_part ::= {basic_declarative_item} */
  766.     case 72 :
  767.         {
  768.             struct two_pool *dec_list,
  769.             *prev,*bottom;
  770.             struct ast *line_node;
  771.             int list_all_done = 0 ;
  772.             struct tok_loc *line_node_span;
  773.  
  774.  
  775.             node = AST (0);
  776.             dec_list = node -> links.list;
  777.  
  778.  
  779.             if (node -> links.list != NULL) {
  780.  
  781.                 dec_list = bottom = node -> links.list;
  782.                 do {
  783.                     prev = dec_list;
  784.                     dec_list = dec_list -> link;
  785.                     list_all_done = (dec_list == bottom) ;
  786.  
  787.                     if (isbody_node[dec_list -> val.node -> kind])
  788.                         break;
  789.                     line_node = new_node (AS_LINE_NO);
  790.                     line_node_span = get_left_span(dec_list->val.node);
  791.                     line_node -> links.val = line_node_span->line;
  792.                     set_span(line_node,line_node_span);
  793.                     /* Insert a new node with the AS_LINE_NO between dec_list
  794.                         and its predecessor */
  795.                     prev -> link = initlist (line_node) ;
  796.                     prev->link->link = dec_list;
  797.                 } while (dec_list != bottom);
  798.  
  799.                 /* If a body node was found, ensure that no simple decl follows
  800.                   * Since the above looped using dec_list, we can start from
  801.                  * dec_list.
  802.                  */
  803.                 if (!list_all_done) {
  804.                     do {
  805.                         dec_list = dec_list -> link;
  806.                         if(!islater_declarative_node[dec_list->val.node-> kind])
  807.                             syntax_err (SPAN (dec_list -> val.node),
  808.                               "Misplaced basic_declarative_item");
  809.  
  810.                     }                while (dec_list != bottom);
  811.                 }
  812.             }
  813.             node -> kind = AS_DECLARATIONS;
  814.         }
  815.  
  816.         /* basic_declarative_item ::= basic_declaration */
  817.         /* case 73 : */
  818.  
  819.         /* basic_declarative_item ::= representation_clause */
  820.         /* case 74 : */
  821.  
  822.         /* basic_declarative_item ::= use_clause */
  823.         /* case 75 : */
  824.  
  825.         /* basic_declarative_item ::= body */
  826.         /* case 76 : */
  827.  
  828.         /* body ::= proper_body */
  829.         /* case 77 : */
  830.  
  831.         /* body ::= body_stub */
  832.         /* case 78 : */
  833.  
  834.         /* proper_body ::= subprogram_body */
  835.         /* case 79 : */
  836.  
  837.         /* proper_body ::= package_body */
  838.         /* case 80 : */
  839.  
  840.         /* proper_body ::= task_body */
  841.         /* case 81 : */
  842.  
  843.         /* name ::= simple_name */
  844.         /* case 82 : */
  845.  
  846.         break;
  847.         /* name ::= character_literal */
  848.     case 83 :
  849. #define char_lit IND(0)
  850.         NN(AS_CHARACTER_LITERAL);
  851.         node->links.val = char_lit;
  852.         set_span(node,LOC(0));
  853. #undef char_list
  854.  
  855.         break;
  856.         /* name ::= operator_symbol */
  857.     case 84 :
  858.         node = AST(0);
  859.         node->kind = AS_STRING;
  860.  
  861.         /* name ::= indexed_component */
  862.         /* case 85 : */
  863.  
  864.         /* name ::= selected_component */
  865.         /* case 86 : */
  866.  
  867.         /* name ::= attribute */
  868.         /* case 87 : */
  869.  
  870.         break;
  871.         /* simple_name ::= identifier */
  872.     case 88 :
  873. #define id IND(0)
  874.         NN(AS_SIMPLE_NAME);
  875.         node->links.val = id;
  876.         set_span(node,LOC(0));
  877. #undef id
  878.  
  879.         break;
  880.         /* indexed_component ::= prefix general_aggregate */
  881.     case 89 :
  882. #define prefix AST(0)
  883. #define general_aggregate AST(1)
  884.         {
  885.             int kind;
  886.  
  887.             /* second argument of attribute is N_AST[3] */
  888. #define arg2  (prefix->links.subast)[2]
  889.  
  890.             if (prefix->kind == AS_ATTRIBUTE && arg2 == opt_node)
  891.             /* do the following checks only if have not yet processed the node*/
  892.             {
  893.                 node = prefix;
  894. #define general_component (general_aggregate->links.list->link->val.node)
  895.                 if (general_aggregate->links.list == NULL
  896.                   || general_aggregate->links.list->link != 
  897.                    general_aggregate->links.list
  898.                   || (kind = general_component->kind) == AS_CHOICE_LIST
  899.                   || kind == AS_RANGE || kind == AS_SUBTYPE) {
  900.                     syntax_err(SPAN(general_aggregate),
  901.                       "Illegal expression for argument of attribute");
  902.                     (node->links.subast)[2] = opt_node;
  903.                     free_everything(general_aggregate);
  904.                 }
  905.                 else {
  906.                     (node->links.subast)[2] = general_component;
  907.                     nodefree(general_aggregate);
  908.                 }
  909.                 (node->links.subast)[3] = NULL;
  910. #undef general_component
  911. #undef arg2
  912.             }
  913.             else {
  914.                 if (prefix->kind == AS_STRING && 
  915.                   !isoverloadable_op(namelist(prefix->links.val))) {
  916.                     char msg[200];
  917.  
  918.                     sprintf(msg,"\"%s\" is not a valid operator_symbol",
  919.                       namelist(prefix->links.val));
  920.                     syntax_err(SPAN(prefix),msg);
  921.                 }
  922.                 NN(AS_CALL_UNRESOLVED);
  923.                 NAST2(prefix,general_aggregate);
  924.             }
  925.         }
  926. #undef prefix
  927. #undef general_aggregate
  928.  
  929.         break;
  930.         /* selected_component ::= prefix . selector */
  931.     case 90 :
  932. #define prefix AST(0)
  933. #define selector AST(2)
  934.         if (selector->kind == AS_ALL) {
  935.             node = selector;
  936.             NAST1(prefix);
  937.         }
  938.         else {
  939.             NN(AS_SELECTOR);
  940.             NAST2(prefix,selector);
  941.         }
  942. #undef prefix
  943. #undef selector
  944.  
  945.         /* selector ::= simple_name */
  946.         /* case 91 : */
  947.  
  948.         break;
  949.         /* selector ::= character_literal */
  950.     case 92 :
  951. #define lit IND(0)
  952.         NN(AS_CHARACTER_LITERAL);
  953.         node->links.val = lit;
  954.         set_span(node,LOC(0));
  955. #undef lit
  956.  
  957.         break;
  958.         /* selector ::= operator_symbol */
  959.     case 93 :
  960.         {
  961.             char tmp[200];
  962.  
  963.             node = AST(0);
  964.             strcpy(tmp,namelist(node->links.val));
  965.             convtolower(tmp);
  966.             if (!isoverloadable_op(tmp)) {
  967.                 char msg[300];
  968.  
  969.                 sprintf(msg,"\"%s\" is not a valid operator_symbol",tmp);
  970.                 syntax_err(get_left_span(node),get_right_span(node),msg);
  971.             }
  972.             node->links.val = namemap(tmp,strlen(tmp));
  973.         }
  974.  
  975.         break;
  976.         /* selector ::= ALL */
  977.     case 94 :
  978.         NN(AS_ALL);
  979.  
  980.         break;
  981.         /* attribute ::= prefix ' attribute_designator */
  982.     case 95 :
  983. #define prefix AST(0)
  984. #define attr_desig AST(2)
  985.         NN(AS_ATTRIBUTE);
  986.         NAST3(attr_desig,prefix,opt_node);
  987. #undef prefix
  988. #undef attr_desig
  989.  
  990.         /* attribute_designator ::= simple_name */
  991.         /* case 96 : */
  992.  
  993.         break;
  994.         /* attribute_designator ::= DIGITS */
  995.     case 97 :
  996.  
  997.         /* attribute_designator ::= DELTA */
  998.     case 98 :
  999.  
  1000.         /* attribute_designator ::= RANGE */
  1001.     case 99 :
  1002. #define keyword IND(0)
  1003.         NN(AS_SIMPLE_NAME);
  1004.         node->links.val = keyword;
  1005.         set_span(node,LOC(0));
  1006. #undef keyword
  1007.  
  1008.         break;
  1009.         /* aggregate ::= ( component_association {,component_association} ) */
  1010.     case 100 :
  1011. #define comp_assoc AST(1)
  1012. #define comp_assoc_node AST(2)
  1013.         if (comp_assoc_node->links.list == NULL
  1014.           && comp_assoc->kind != AS_CHOICE_LIST) {
  1015.             NN(AS_PARENTHESIS);
  1016.             NAST1(comp_assoc);
  1017.             nodefree(comp_assoc_node);
  1018.         }
  1019.         else {
  1020.             node = comp_assoc_node;
  1021.             prepend(comp_assoc,node);
  1022.             node->kind = AS_AGGREGATE;
  1023.         }
  1024. #undef comp_assoc
  1025. #undef comp_assoc_node
  1026.  
  1027.         /* component_association ::= [choice{|choice}=>]expression */
  1028.         /* case 101 : */
  1029.  
  1030.         break;
  1031.         /* general_aggregate ::=
  1032.             ( general_component_association {,general_component */
  1033.     case 102 :
  1034. #define gen_comp_assoc AST(1)
  1035.         node = AST(2);
  1036.         prepend(gen_comp_assoc,node);
  1037. #undef gen_comp_assoc
  1038.  
  1039.         /* general_component_association ::= component_association */
  1040.         /* case 103 : */
  1041.  
  1042.         break;
  1043.         /* general_component_association ::=
  1044.             simple_expression .. simple_expression */
  1045.     case 104 :
  1046. #define simple_expr1 AST(0)
  1047. #define simple_expr2 AST(2)
  1048.         NN(AS_RANGE);
  1049.         NAST2(simple_expr1,simple_expr2);
  1050. #undef simple_expr1
  1051. #undef simple_expr2
  1052.  
  1053.         break;
  1054.         /* general_component_association ::= name range_constraint */
  1055.     case 105 :
  1056. #define name AST(0)
  1057. #define range_constraint AST(1)
  1058.         if (!check_expanded_name(name))
  1059.             syntax_err(SPAN(name),"subtype_indicaiton must be a type_mark");
  1060.         NN(AS_SUBTYPE);
  1061.         NAST2(name,range_constraint);
  1062. #undef name
  1063. #undef range_constraint
  1064.  
  1065.         /* expression ::= relation */
  1066.         /* case 106 : */
  1067.  
  1068.         /* expression ::= relation{AND__relation} */
  1069.         /* case 107 : */
  1070.  
  1071.         /* expression ::= relation{OR__relation} */
  1072.         /* case 108 : */
  1073.  
  1074.         /* expression ::= relation{XOR__relation} */
  1075.         /* case 109 : */
  1076.  
  1077.         /* expression ::= relation{AND__THEN__relation} */
  1078.         /* case 110 : */
  1079.  
  1080.         /* expression ::= relation{OR__ELSE__relation} */
  1081.         /* case 111 : */
  1082.  
  1083.         break;
  1084.         /* relation ::=
  1085.             simple_expression [relational_operator__simple_expression] */
  1086.     case 112 :
  1087. #define simple_expr1 AST(0)
  1088. #define arg_list_node ((node->links.subast)[1])
  1089.         if ((node = AST(1)) == opt_node)
  1090.             node = simple_expr1;
  1091.         else
  1092.             arg_list_node->links.list->link->val.node = simple_expr1;
  1093. #undef simple_expr1
  1094. #undef arg_list_node
  1095.  
  1096.         break;
  1097.         /* relation ::= simple_expression [NOT] IN range */
  1098.     case 113 :
  1099. #define simple_expr AST(0)
  1100. #define opt_not AST(1)
  1101. #define optr IND(2)
  1102. #define optrloc LOC(2)
  1103. #define ast_range AST(3)
  1104.         {
  1105.             int kind, op_name;
  1106.             struct ast *arg_list_node, *simple_name;
  1107.             struct two_pool *tmp;
  1108.             struct tok_loc *old_span;
  1109.  
  1110.             if (opt_not != opt_node) {
  1111.                 kind = AS_NOTIN;
  1112.                 op_name = namemap("notin",5);
  1113.             }
  1114.             else if (!strcmp(namelist(optr),"any_op"))
  1115.                 kind = AS_ANY_OP;
  1116.             else {
  1117.                 kind = AS_IN;
  1118.                 op_name = namemap("in",2);
  1119.             }
  1120.             switch (ast_range->kind) {
  1121.             case AS_RANGE_EXPRESSION :
  1122. #define name ((ast_range->links.subast)[0])
  1123.                 if (!check_expanded_name(name))
  1124.                     syntax_err(SPAN(ast_range),
  1125.                       "Invalid expression used as range specification");
  1126.                 break;
  1127. #undef name
  1128.             case AS_RANGE :
  1129.             case AS_RANGE_ATTRIBUTE :
  1130.                 break;
  1131.             default :
  1132.                 syntax_err(SPAN(ast_range),"Invalid range specification");
  1133.                 /* fix up to satisfy adasem */
  1134.                 old_span = LOC(3);
  1135.                 ast_range = new_node(AS_RANGE_EXPRESSION);
  1136.                 ast_range->links.subast = new_ast1(new_node(AS_SIMPLE_NAME));
  1137.                 (ast_range->links.subast[0])->links.val = namemap("any_id",6);
  1138.                 set_span(ast_range->links.subast[0],old_span);
  1139.             }
  1140.             NN(kind);
  1141.             simple_name = new_node(AS_SIMPLE_NAME);
  1142.             set_span(simple_name,(opt_not!=opt_node ? &opt_not->span :optrloc));
  1143.             simple_name->links.val = op_name;
  1144.             arg_list_node = new_node(AS_LIST);
  1145.             (arg_list_node->links.list = TALLOC())->val.node = ast_range;
  1146.             (arg_list_node->links.list->link = tmp = TALLOC())->val.node =
  1147.               simple_expr;
  1148.             tmp->link = arg_list_node->links.list;
  1149.             NAST2(simple_name,arg_list_node);
  1150.         }
  1151. #undef simple_expr
  1152. #undef opt_not
  1153. #undef optr
  1154. #undef optrloc
  1155. #undef ast_range
  1156.  
  1157.         /* simple_expression ::=
  1158.             [unary_adding_operator]term{binary_adding_operator_ */
  1159.         /* case 114 : */
  1160.  
  1161.         /* term ::= factor{multiplying_operator__factor} */
  1162.         /* case 115 : */
  1163.  
  1164.         break;
  1165.         /* factor ::= primary [**__primary] */
  1166.     case 116 :
  1167. #define primary1 AST(0)
  1168. #define arg_list_node ((node->links.subast)[1])
  1169.         if ((node = AST(1)) == opt_node)
  1170.             node = primary1;
  1171.         else
  1172.             arg_list_node->links.list->link->val.node = primary1;
  1173. #undef arg_list_node
  1174. #undef primary1
  1175.  
  1176.         break;
  1177.         /* factor ::= ABS primary */
  1178.     case 117 :
  1179. #define optrloc LOC(0)
  1180. #define primary AST(1)
  1181.         {
  1182.             struct ast *optr_node;
  1183.  
  1184.             optr_node = new_node(AS_SIMPLE_NAME);
  1185.             optr_node->links.val = namemap("abs",3);
  1186.             set_span(optr_node,optrloc);
  1187.             node = unary_operator(optr_node,primary);
  1188.         }
  1189. #undef optrloc
  1190. #undef primary
  1191.  
  1192.         break;
  1193.         /* factor ::= NOT primary */
  1194.     case 118 :
  1195. #define optrloc LOC(0)
  1196. #define primary AST(1)
  1197.         {
  1198.             struct ast *optr_node;
  1199.  
  1200.             optr_node = new_node(AS_SIMPLE_NAME);
  1201.             optr_node->links.val = namemap("not",3);
  1202.             set_span(optr_node,optrloc);
  1203.             node = unary_operator(optr_node,primary);
  1204.         }
  1205. #undef optrloc
  1206. #undef primary
  1207.  
  1208.         break;
  1209.         /* primary ::= numeric_literal */
  1210.     case 119 :
  1211. #define num_lit IND(0)
  1212.         NN((strchr(namelist(num_lit),'.')) ? AS_REAL_LITERAL :
  1213.           AS_INT_LITERAL);
  1214.         node->links.val = num_lit;
  1215.         set_span(node,LOC(0));
  1216. #undef num_lit
  1217.  
  1218.         break;
  1219.         /* primary ::= NULL */
  1220.     case 120 :
  1221.         NN(AS_NULL);
  1222.         set_span(node,LOC(0));
  1223.  
  1224.         /* primary ::= aggregate */
  1225.         /* case 121 : */
  1226.  
  1227.         break;
  1228.         /* primary ::= name */
  1229.     case 122 :
  1230. #define name_node AST(0)
  1231.         if (name_node->kind == AS_STRING) {
  1232.             node = name_node;
  1233.             node->kind = AS_STRING_LITERAL;
  1234.         }
  1235.         else {
  1236.             NN(AS_NAME);
  1237.             NAST1(name_node);
  1238.         }
  1239. #undef name_node
  1240.  
  1241.         /* primary ::= allocator */
  1242.         /* case 123 : */
  1243.  
  1244.         /* primary ::= qualified_expression */
  1245.         /* case 124 : */
  1246.  
  1247.         break;
  1248.         /* relational_operator ::= = */
  1249.     case 125 :
  1250.  
  1251.         /* relational_operator ::= /= */
  1252.     case 126 :
  1253.  
  1254.         /* relational_operator ::= < */
  1255.     case 127 :
  1256.  
  1257.         /* relational_operator ::= <= */
  1258.     case 128 :
  1259.  
  1260.         /* relational_operator ::= > */
  1261.     case 129 :
  1262.  
  1263.         /* relational_operator ::= >= */
  1264.     case 130 :
  1265.  
  1266.         /* binary_adding_operator ::= + */
  1267.     case 131 :
  1268.  
  1269.         /* binary_adding_operator ::= - */
  1270.     case 132 :
  1271.  
  1272.         /* binary_adding_operator ::= & */
  1273.     case 133 :
  1274. #define optr IND(0)
  1275.         NN(AS_SIMPLE_NAME);
  1276.         node->links.val = optr;
  1277.         set_span(node,LOC(0));
  1278. #undef optr
  1279.  
  1280.         break;
  1281.         /* unary_adding_operator ::= + */
  1282.     case 134 :
  1283.  
  1284.         /* unary_adding_operator ::= - */
  1285.     case 135 :
  1286. #define optr IND(0)
  1287.         {
  1288.             char str[6];
  1289.  
  1290.             NN(AS_SIMPLE_NAME);
  1291.             sprintf(str,"%s",namelist(optr));
  1292.             node->links.val = namemap(str,1);
  1293.             set_span(node,LOC(0));
  1294.         }
  1295. #undef optr
  1296.  
  1297.         break;
  1298.         /* multiplying_operator ::= * */
  1299.     case 136 :
  1300.  
  1301.         /* multiplying_operator ::= / */
  1302.     case 137 :
  1303. #define optr IND(0)
  1304.         NN(AS_SIMPLE_NAME);
  1305.         node->links.val = optr;
  1306.         set_span(node,LOC(0));
  1307. #undef optr
  1308.  
  1309.         break;
  1310.         /* multiplying_operator ::= MOD */
  1311.     case 138 :
  1312.         NN(AS_SIMPLE_NAME);
  1313.         node->links.val = namemap("mod",3);
  1314.         set_span(node,LOC(0));
  1315.  
  1316.         break;
  1317.         /* multiplying_operator ::= REM */
  1318.     case 139 :
  1319.         NN(AS_SIMPLE_NAME);
  1320.         node->links.val =  namemap("rem",3);
  1321.         set_span(node,LOC(0));
  1322.  
  1323.         break;
  1324.         /* qualified_expression ::= name ' aggregate */
  1325.     case 140 :
  1326. #define name AST(0)
  1327. #define aggregate AST(2)
  1328.         if (!check_expanded_name(name))
  1329.             syntax_err(SPAN(name),
  1330.               "Invalid type_mark found in qualified_expression");
  1331.         if (aggregate->kind == AS_PARENTHESIS) { /* remove parentheses */
  1332.             aggregate = aggregate->links.subast[0];
  1333.         }
  1334.         NN(AS_QUALIFY);
  1335.         NAST2(name,aggregate);
  1336. #undef name
  1337. #undef aggregate
  1338.  
  1339.         break;
  1340.         /* allocator ::= NEW type_mark */
  1341.     case 141 :
  1342. #define type_mark AST(1)
  1343.         NN(AS_NEW);
  1344.         NAST2(type_mark,opt_node);
  1345. #undef type_mark
  1346.  
  1347.         break;
  1348.         /* allocator ::= NEW type_mark general_aggregate */
  1349.     case 142 :
  1350. #define type_mark AST(1)
  1351. #define general_aggregate AST(2)
  1352.         NN(AS_NEW);
  1353.         NAST2(type_mark,general_aggregate);
  1354. #undef type_mark
  1355. #undef general_aggregate
  1356.  
  1357.         break;
  1358.         /* allocator ::= NEW type_mark ' aggregate */
  1359.     case 143 :
  1360. #define type_mark AST(1)
  1361. #define aggregate AST(3)
  1362.         NN(AS_NEW_INIT);
  1363.         NAST2(type_mark,aggregate);
  1364. #undef type_mark
  1365. #undef aggregate
  1366.  
  1367.         break;
  1368.         /* sequence_of_statements ::= {pragma} statement {statement} */
  1369.     case 144 :
  1370. #define pragma_node AST(0)
  1371. #define stmt AST(1)
  1372. #define stmt_node AST(2) 
  1373.         {
  1374.             struct ast *label_list_node, *line_node;
  1375.             struct two_pool *nodelabels = NULL, *lablistlabels = NULL;
  1376.             struct two_pool *prev;
  1377.             struct tok_loc *line_node_span;
  1378.  
  1379.             check_pragmas(pragma_node,null_pragmas);
  1380.             NN(AS_STATEMENTS);
  1381.             stmt_node->links.list = concatl3(pragma_node->links.list,
  1382.               initlist(stmt),stmt_node->links.list);
  1383.             label_list_node = new_node(AS_LIST);
  1384.             prev = stmt_node->links.list;  /* bottom of list */
  1385.             LLOOPTOP(stmt_node->links.list,tmp)
  1386.                 nodelabels = concatl(nodelabels,
  1387.                   copylist(getlabels(tmp->val.node)));
  1388.                 if (tmp->val.node->kind == AS_STATEMENT)
  1389.                     lablistlabels = concatl(lablistlabels,
  1390.                       copylist((tmp->val.node->links.subast)[0]->links.list));
  1391.                 if (tmp->val.node->kind != AS_PRAGMA) {
  1392.                     /* insert AS_LINE_NO node before the current node (tmp) */
  1393.                     line_node = new_node(AS_LINE_NO);
  1394.                     line_node_span = get_left_span(tmp->val.node);
  1395.                     line_node->links.val = line_node_span->line;
  1396.                     set_span(line_node,line_node_span);
  1397.                     prev->link = initlist(line_node);
  1398.                     prev->link->link = tmp;
  1399.                 }
  1400.                 prev = tmp;
  1401.             LLOOPBOTTOM(tmp)
  1402.             /* add as_line_no node for next token (curtok) to end of stmt_list*/
  1403.             end_as_line_no(stmt_node,curtok);
  1404.             newlabels(node,nodelabels);
  1405.             label_list_node->links.list = lablistlabels;
  1406.             if (lablistlabels == NULL)
  1407.                 set_span(label_list_node,&curtok->ptr.token->loc);
  1408.             NAST2(stmt_node,label_list_node);
  1409.             nodefree(pragma_node);
  1410.         }
  1411. #undef pragma_node
  1412. #undef stmt
  1413. #undef stmt_node
  1414.  
  1415.         break;
  1416.         /* statement ::= {label} simple_statement */
  1417.     case 145 :
  1418. #define labs_node AST(0)
  1419. #define stmt AST(1)
  1420.         if (labs_node->links.list != NULL) {
  1421.             NN(AS_STATEMENT);
  1422.             NAST2(labs_node,stmt);
  1423.             newlabels(node,copylist(labs_node->links.list));
  1424.         }
  1425.         else {
  1426.             node = stmt;
  1427.             nodefree(labs_node);
  1428.         }
  1429. #undef labs_node
  1430. #undef stmt
  1431.  
  1432.         break;
  1433.         /* statement ::= {label} compound_statement */
  1434.     case 146 :
  1435. #define labs_node AST(0)
  1436. #define stmt AST(1)
  1437.         if (labs_node->links.list != NULL) {
  1438.             NN(AS_STATEMENT);
  1439.             NAST2(labs_node,stmt);
  1440.             newlabels(node,concatl(copylist(labs_node->links.list),
  1441.               copylist(getlabels(stmt))));
  1442.         }
  1443.         else {
  1444.             node = stmt;
  1445.             nodefree(labs_node);
  1446.         }
  1447. #undef labs_node
  1448. #undef stmt
  1449.  
  1450.         /* simple_statement ::= null_statement */
  1451.         /* case 147 : */
  1452.  
  1453.         /* simple_statement ::= assignment_statement */
  1454.         /* case 148 : */
  1455.  
  1456.         /* simple_statement ::= exit_statement */
  1457.         /* case 149 : */
  1458.  
  1459.         /* simple_statement ::= return_statement */
  1460.         /* case 150 : */
  1461.  
  1462.         /* simple_statement ::= goto_statement */
  1463.         /* case 151 : */
  1464.  
  1465.         /* simple_statement ::= delay_statement */
  1466.         /* case 152 : */
  1467.  
  1468.         /* simple_statement ::= abort_statement */
  1469.         /* case 153 : */
  1470.  
  1471.         /* simple_statement ::= raise_statement */
  1472.         /* case 154 : */
  1473.  
  1474.         /* simple_statement ::= code_statement */
  1475.         /* case 155 : */
  1476.  
  1477.         /* simple_statement ::= call_statement */
  1478.         /* case 156 : */
  1479.  
  1480.         /* compound_statement ::= if_statement */
  1481.         /* case 157 : */
  1482.  
  1483.         /* compound_statement ::= case_statement */
  1484.         /* case 158 : */
  1485.  
  1486.         /* compound_statement ::= loop_statement */
  1487.         /* case 159 : */
  1488.  
  1489.         /* compound_statement ::= block_statement */
  1490.         /* case 160 : */
  1491.  
  1492.         /* compound_statement ::= accept_statement */
  1493.         /* case 161 : */
  1494.  
  1495.         /* compound_statement ::= select_statement */
  1496.         /* case 162 : */
  1497.  
  1498.         break;
  1499.         /* label ::= << label_simple_name >> */
  1500.     case 163 :
  1501.         node = AST(1);
  1502.  
  1503.         break;
  1504.         /* null_statement ::= NULL ; */
  1505.     case 164 :
  1506.         NN(AS_NULL_S);
  1507.         set_span(node,LOC(0));
  1508.  
  1509.         break;
  1510.         /* assignment_statement ::= variable_name := expression ; */
  1511.     case 165 :
  1512. #define name AST(0)
  1513. #define expression AST(2)
  1514.         NN(AS_ASSIGNMENT);
  1515.         NAST2(name,expression);
  1516. #undef name
  1517. #undef expression
  1518.  
  1519.         break;
  1520.         /* if_statement ::=
  1521.             IF condition THEN sequence_of_statements {ELSIF__conditi */
  1522.     case 166 :
  1523. #define expression AST(1)
  1524. #define stmts AST(3)
  1525. #define if_list_node AST(4)
  1526. #define opt_else AST(5)
  1527.         {
  1528.             struct ast *if_node;
  1529.             struct two_pool *nodelabels = NULL;
  1530.  
  1531.             NN(AS_IF);
  1532.             if_node = new_node(AS_COND_STATEMENTS);
  1533.             if_node->links.subast = new_ast2(expression,stmts);
  1534.             prepend(if_node,if_list_node);
  1535.             LLOOPTOP(if_list_node->links.list,tmp)
  1536.                 nodelabels = concatl(nodelabels,
  1537.                   copylist(getlabels((tmp->val.node->links.subast)[1])));
  1538.             LLOOPBOTTOM(tmp)
  1539.             if (opt_else != opt_node)
  1540.                 nodelabels = concatl(nodelabels,copylist(getlabels(opt_else)));
  1541.             newlabels(node,nodelabels);
  1542.             NAST2(if_list_node,opt_else);
  1543.         }
  1544. #undef expression
  1545. #undef stmts
  1546. #undef if_list_node
  1547. #undef opt_else
  1548.  
  1549.         break;
  1550.         /* condition ::= boolean_expression */
  1551.     case 167 :
  1552. #define boolean_expression AST(0)
  1553.         NN(AS_CONDITION);
  1554.         NAST1(boolean_expression);
  1555. #undef boolean_expression
  1556.  
  1557.         break;
  1558.         /* case_statement ::=
  1559.             CASE expression IS {pragma} case_statement_alternative */
  1560.     case 168 :
  1561. #define expression AST(1)
  1562. #define pragma_node AST(3)
  1563. #define alt AST(4)
  1564. #define alt_node AST(5)
  1565.         {
  1566.             struct two_pool *nodelabels = NULL;
  1567.  
  1568.             NN(AS_CASE);
  1569.             check_pragmas(pragma_node,null_pragmas);
  1570.             alt_node->links.list=concatl3(pragma_node->links.list,initlist(alt),
  1571.               alt_node->links.list);
  1572.             check_choices(alt_node,"a case_statement");
  1573.             nodefree(pragma_node);
  1574.             LLOOPTOP(alt_node->links.list,tmp)
  1575.                 nodelabels = concatl(nodelabels,
  1576.                   copylist(getlabels((tmp->val.node->links.subast)[1])));
  1577.             LLOOPBOTTOM(tmp)
  1578.                 newlabels(node,nodelabels);
  1579.             NAST2(expression,alt_node);
  1580.         }
  1581. #undef expression
  1582. #undef pragma_node
  1583. #undef alt
  1584. #undef alt_node
  1585.  
  1586.         break;
  1587.         /* case_statement_alternative ::=
  1588.             WHEN choice {|choice} => sequence_of_state */
  1589.     case 169 :
  1590. #define choice AST(1)
  1591. #define choice_node AST(2)
  1592. #define stmts AST(4)
  1593.         prepend(choice,choice_node);
  1594.         NN(AS_CASE_STATEMENTS);
  1595.         NAST2(choice_node,stmts);
  1596. #undef choice
  1597. #undef choice_node
  1598. #undef stmts
  1599.  
  1600.         break;
  1601.         /* loop_statement ::=
  1602.             [loop_simple_name:] [iteration_scheme] LOOP sequence_o */
  1603.     case 170 :
  1604. #define iteration_scheme AST(1)
  1605. #define stmts AST(3)
  1606. #define simple_name2 AST(6)
  1607.         {
  1608.             struct ast *simple_name1;
  1609.             struct tok_loc *left_span, *right_span ;
  1610.  
  1611.             simple_name1 = AST(0);
  1612.             if (simple_name1 != opt_node)
  1613.                 left_span = get_left_span(simple_name1);
  1614.             else if (iteration_scheme != opt_node)
  1615.                 left_span = get_left_span(iteration_scheme);
  1616.             else left_span = LOC(2);
  1617.             if (simple_name2 != opt_node)
  1618.                 right_span = get_right_span(simple_name2);
  1619.             else right_span = END_LOC(5);
  1620.             NN(AS_LOOP);
  1621.             if (simple_name1 != opt_node) {
  1622.                 if (simple_name2 != opt_node) {
  1623.                     if (simple_name1->links.val != simple_name2->links.val)
  1624.                         match_error(simple_name1->links.val,
  1625.                           simple_name2->links.val, "loop_statement",
  1626.                           left_span,right_span);
  1627.                 }
  1628.                 else {
  1629.                     char msg[200];
  1630.  
  1631.                     sprintf(msg,
  1632. "%s at beginning of loop_statement does not match non-existent \
  1633. \"loop_simple_name\" at END LOOP", namelist(simple_name1->links.val));
  1634.                     syntax_err(left_span,right_span,msg);
  1635.                 }
  1636.             }
  1637.             else {
  1638.                 char newlabel[15];
  1639.  
  1640.                 if (simple_name2 != opt_node) {
  1641.                     char msg[200];
  1642.  
  1643.                     sprintf(msg,
  1644. "Non existent \"loop_simple_name:\" at beginning of loop_statement does \
  1645. not match %s", namelist(simple_name2->links.val));
  1646.                     syntax_err(left_span,right_span,msg);
  1647.                 }
  1648.                 simple_name1 = new_node(AS_SIMPLE_NAME);
  1649.                 sprintf(newlabel,"#%x",simple_name1);
  1650.                 simple_name1->links.val = namemap(newlabel,strlen(newlabel));
  1651.                 set_span(simple_name1,left_span);
  1652.             }
  1653.             newlabels(node,concatl(initlist(simple_name1),
  1654.               copylist(getlabels(stmts))));
  1655.             NAST3(simple_name1,iteration_scheme,stmts);
  1656.  
  1657.             nodefree(simple_name2);
  1658.         }
  1659. #undef iteration_scheme
  1660. #undef stmts
  1661. #undef simple_name2
  1662.  
  1663.         break;
  1664.         /* iteration_scheme ::= WHILE condition */
  1665.     case 171 :
  1666. #define expression AST(1)
  1667.         NN(AS_WHILE);
  1668.         NAST1(expression);
  1669. #undef expression
  1670.  
  1671.         break;
  1672.         /* iteration_scheme ::= FOR loop_parameter_specification */
  1673.     case 172 :
  1674.         node = AST(1);
  1675.  
  1676.         break;
  1677.         /* loop_parameter_specification ::=
  1678.             identifier IN [REVERSE] discrete_range */
  1679.     case 173 :
  1680. #define opt_rev AST(2)
  1681. #define discrete_range AST(3)
  1682.         check_discrete_range(discrete_range);
  1683.         NN((opt_rev == opt_node) ? AS_FOR : AS_FORREV);
  1684.         make_id(0);
  1685.         NAST2(id_node,discrete_range);
  1686. #undef opt_rev
  1687. #undef discrete_range
  1688.  
  1689.         break;
  1690.         /* block_statement ::=
  1691.             [block_simple_name:] [DECLARE__declarative_part] BEGI */
  1692.     case 174 :
  1693. #define decl_part AST(1)
  1694. #define stmts AST(3)
  1695. #define opt_except_list AST(4)
  1696. #define simple_name2 AST(6)
  1697.         {
  1698.             struct ast *simple_name1, *labs_node;
  1699.             struct tok_loc *left_span, *right_span ;
  1700.  
  1701.             simple_name1 = AST(0);
  1702.             if (simple_name1 != opt_node)
  1703.                 left_span = get_left_span(simple_name1);
  1704.             else if (decl_part != opt_node)
  1705.                 left_span = get_left_span(decl_part);
  1706.             else left_span = LOC(2);
  1707.             if (simple_name2 != opt_node)
  1708.                 right_span = get_right_span(simple_name2);
  1709.             else right_span = END_LOC(5);
  1710.  
  1711.             NN(AS_BLOCK);
  1712.             if (simple_name1 != opt_node) {
  1713.                 if (simple_name2 != opt_node) {
  1714.                     if (simple_name1->links.val != simple_name2->links.val)
  1715.                         match_error(simple_name1->links.val,
  1716.                           simple_name2->links.val, "block_statement",
  1717.                           left_span,right_span);
  1718.                 }
  1719.                 else {
  1720.                     char msg[200];
  1721.  
  1722.                     sprintf(msg,
  1723. "%s at beginning of block_statement does not match non-existent \
  1724. \"block_simple_name\" at end of block", namelist(simple_name1->links.val));
  1725.                     syntax_err(left_span,right_span,msg);
  1726.                 }
  1727.             }
  1728.             else {
  1729.                 char newlabel[15];
  1730.  
  1731.                 if (simple_name2 != opt_node) {
  1732.                     char msg[200];
  1733.  
  1734.                     sprintf(msg,
  1735. "Non-existent \"block_simple_name:\" at beginning of block_statement does \
  1736. not match %s", namelist(simple_name2->links.val));
  1737.                     syntax_err(get_left_span(simple_name2),
  1738.                       get_right_span(simple_name2),msg);
  1739.                 }
  1740.                 simple_name1 = new_node(AS_SIMPLE_NAME);
  1741.                 sprintf(newlabel,"#%x",simple_name1);
  1742.                 simple_name1->links.val = namemap(newlabel,strlen(newlabel));
  1743.                 set_span(simple_name1,left_span);
  1744.             }
  1745.  
  1746.             /* The labels declared within a block are grouped together under
  1747.              * a single node : labs_node.  This node is then passed upwards
  1748.              * to help prevent duplicate declaration of labels within a program
  1749.              * unit.  (see remove_duplicate_labels)
  1750.              */
  1751.  
  1752.             labs_node = new_node(AS_LABELS);
  1753.             labs_node->links.list = remove_duplicate_labels(
  1754.               concatl(copylist(getlabels(stmts)),
  1755.               ((opt_except_list == opt_node) ? (struct two_pool *)0 : 
  1756.               copylist(getlabels(opt_except_list)))));
  1757.             newlabels(node,concatl(initlist(simple_name1),initlist(labs_node)));
  1758.             append(decl_part,labs_node);
  1759.             NAST4(simple_name1,decl_part,stmts,opt_except_list);
  1760.             nodefree(simple_name2);
  1761.         }
  1762. #undef decl_part
  1763. #undef stmts
  1764. #undef opt_except_list
  1765. #undef simple_name2
  1766.  
  1767.         break;
  1768.         /* exit_statement ::= EXIT [loop_name] [WHEN__condition] ; */
  1769.     case 175 :
  1770. #define opt_name AST(1)
  1771. #define opt_expression AST(2)
  1772.         {
  1773.             struct ast *span_node;
  1774.  
  1775.             NN(AS_EXIT);
  1776.             span_node = new_node(AS_SIMPLE_NAME);
  1777.             span_node->links.val = IND(0);
  1778.             set_span(span_node,LOC(0));
  1779.             NAST4(opt_name,opt_expression,opt_node,span_node);
  1780.         }
  1781. #undef opt_name
  1782. #undef opt_expression
  1783.  
  1784.         break;
  1785.         /* return_statement ::= RETURN [expression] ; */
  1786.     case 176 :
  1787. #define opt_expression AST(1)
  1788.         {
  1789.             struct ast *span_node;
  1790.  
  1791.             NN(AS_RETURN);
  1792.             span_node = new_node(AS_SIMPLE_NAME);
  1793.             span_node->links.val = IND(0);
  1794.             set_span(span_node,LOC(0));
  1795.             NAST4(opt_expression,opt_node,opt_node,span_node);
  1796.         }
  1797. #undef opt_expression
  1798.  
  1799.         break;
  1800.         /* goto_statement ::= GOTO label_name ; */
  1801.     case 177 :
  1802. #define name AST(1)
  1803.         NN(AS_GOTO);
  1804.         NAST1(name);
  1805. #undef name
  1806.  
  1807.         break;
  1808.         /* subprogram_declaration ::= subprogram_specification ; */
  1809.     case 178 :
  1810. #define subprog_spec AST(0)
  1811.         NN(AS_SUBPROGRAM_DECL);
  1812.         NAST1(subprog_spec);
  1813. #undef subprog_spec
  1814.  
  1815.         break;
  1816.         /* subprogram_specification ::= PROCEDURE identifier [formal_part] */
  1817.     case 179 :
  1818. #define opt_formal AST(2)
  1819.         make_id(1);
  1820.         NN(AS_PROCEDURE);
  1821.         NAST3(id_node,opt_formal,opt_node);
  1822. #undef opt_formal
  1823.  
  1824.         break;
  1825.         /* subprogram_specification ::=
  1826.             FUNCTION designator [formal_part] RETURN typ */
  1827.     case 180 :
  1828. #define desig AST(1)
  1829. #define opt_formal AST(2)
  1830. #define type_mark AST(4)
  1831.         NN(AS_FUNCTION);
  1832.         NAST3(desig,opt_formal,type_mark);
  1833. #undef desig
  1834. #undef opt_formal
  1835. #undef type_mark
  1836.  
  1837.         break;
  1838.         /* designator ::= identifier */
  1839.     case 181 :
  1840. #define id IND(0)
  1841.         NN(AS_SIMPLE_NAME);
  1842.         node->links.val = id;
  1843.         set_span(node,LOC(0));
  1844. #undef id
  1845.  
  1846.         break;
  1847.         /* designator ::= operator_symbol */
  1848.     case 182 :
  1849.         {
  1850.             char tmp[200];
  1851.  
  1852.             node = AST(0);
  1853.             strcpy(tmp,namelist(node->links.val));
  1854.             convtolower(tmp);
  1855.             if (!isoverloadable_op(tmp)) {
  1856.                 char msg[300];
  1857.  
  1858.                 sprintf(msg,"\"%s\" is not a valid operator_symbol",tmp);
  1859.                 syntax_err(get_left_span(node),get_right_span(node),msg);
  1860.             }
  1861.             node->links.val = namemap(tmp,strlen(tmp));
  1862.         }
  1863.  
  1864.         break;
  1865.         /* operator_symbol ::= string_literal */
  1866.     case 183 :
  1867. #define lit IND(0)
  1868.         NN(AS_OPERATOR);
  1869.         node->links.val = lit;
  1870.         set_span(node,LOC(0));
  1871. #undef lit
  1872.  
  1873.         break;
  1874.         /* formal_part ::=
  1875.             ( parameter_specification {;parameter_specification} ) */
  1876.     case 184 :
  1877. #define parm_spec AST(1)
  1878.         node = AST(2);
  1879.         prepend(parm_spec,node);
  1880. #undef parm_spec
  1881.  
  1882.         break;
  1883.         /* parameter_specification ::=
  1884.             identifier_list : mode type_mark [:=expressio */
  1885.     case 185 :
  1886. #define id_list AST(0)
  1887. #define ast_mode AST(2)
  1888. #define type_mark AST(3)
  1889. #define opt_init AST(4)
  1890.         NN(AS_FORMAL);
  1891.         NAST4(id_list,ast_mode,type_mark,opt_init);
  1892. #undef id_list
  1893. #undef ast_mode
  1894. #undef type_mark
  1895. #undef opt_init
  1896.  
  1897.         /* mode ::= [IN] */
  1898.         /* case 186 : */
  1899.  
  1900.         break;
  1901.         /* mode ::= IN OUT */
  1902.     case 187 :
  1903.         NN(AS_MODE);
  1904.         node->links.val = namemap("inout",5);
  1905.         set_span(node,LOC(0));
  1906.  
  1907.         break;
  1908.         /* mode ::= OUT */
  1909.     case 188 :
  1910.         NN(AS_MODE);
  1911.         node->links.val = namemap("out",3);
  1912.         set_span(node,LOC(0));
  1913.  
  1914.         break;
  1915.         /* subprogram_body ::=
  1916.             subprogram_specification IS declarative_part BEGIN se */
  1917.     case 189 :
  1918. #define sub_spec AST(0)
  1919. #define decl_part AST(2)
  1920. #define stmts AST(4)
  1921. #define opt_except_list AST(5)
  1922. #define opt_desig AST(7)
  1923.         {
  1924.             struct ast *labs_node;
  1925.  
  1926. #define desig1 (sub_spec->links.subast)[0]->links.val
  1927. #define desig2 opt_desig->links.val
  1928.             if (opt_desig != opt_node && desig1 != desig2)
  1929.                 match_error(desig1,desig2,"subprogram_body",
  1930.                   get_left_span(sub_spec),get_right_span(opt_desig));
  1931. #undef desig1
  1932. #undef desig2
  1933.             nodefree(opt_desig);
  1934.             labs_node = new_node(AS_LABELS);
  1935.             labs_node->links.list = remove_duplicate_labels(
  1936.               concatl(copylist(getlabels(stmts)),
  1937.               ((opt_except_list == opt_node) ? (struct two_pool *)0 : 
  1938.               copylist(getlabels(opt_except_list)))));
  1939.             append(decl_part,labs_node);
  1940.             NN(AS_SUBPROGRAM);
  1941.             NAST4(sub_spec,decl_part,stmts,opt_except_list);
  1942.         }
  1943. #undef sub_spec
  1944. #undef decl_part
  1945. #undef stmts
  1946. #undef opt_except_list
  1947. #undef opt_desig
  1948.  
  1949.         break;
  1950.         /* call_statement ::= name ; */
  1951.     case 190 :
  1952. #define proc_name AST(0)
  1953.         NN(AS_CALL);
  1954.         NAST1(proc_name);
  1955. #undef proc_name
  1956.  
  1957.         break;
  1958.         /* package_declaration ::= package_specification ; */
  1959.     case 191 :
  1960.         node = AST(0);
  1961.  
  1962.         break;
  1963.         /* package_specification ::=
  1964.             PACKAGE identifier IS {basic_declarative_item}  */
  1965.     case 192 :
  1966. #define id IND(1)
  1967. #define decl_node AST(3)
  1968. #define opt_private_part AST(4)
  1969. #define opt_simple_name AST(6)
  1970.         if (opt_simple_name != opt_node && id != opt_simple_name->links.val)
  1971.             match_error(id,opt_simple_name->links.val,"package_specification",
  1972.               get_left_span(opt_simple_name),get_right_span(opt_simple_name));
  1973.         make_id(1);
  1974.         LLOOPTOP(decl_node->links.list,tmp)
  1975.             if (isbody_node[tmp->val.node->kind])
  1976.             syntax_err(SPAN(tmp->val.node),
  1977.               "Body declaration not allowed in package_specification");
  1978.         LLOOPBOTTOM(tmp)
  1979.         decl_node->kind = AS_DECLARATIONS;
  1980.         ins_as_line_no(decl_node);
  1981.         NN(AS_PACKAGE_SPEC);
  1982.         NAST3(id_node,decl_node,opt_private_part);
  1983.         nodefree(opt_simple_name);
  1984. #undef id
  1985. #undef decl_node
  1986. #undef opt_private_part
  1987. #undef opt_simple_name
  1988.  
  1989.         break;
  1990.         /* package_body ::=
  1991.             PACKAGE BODY package_simple_name IS declarative_part END */
  1992.     case 193 :
  1993. #define simple_name1 AST(2)
  1994. #define decl_part AST(4)
  1995. #define opt_simple_name2 AST(6)
  1996.         if (opt_simple_name2 != opt_node
  1997.           && simple_name1->links.val != opt_simple_name2->links.val)
  1998.             match_error(simple_name1->links.val,opt_simple_name2->links.val,
  1999.               "package_body",get_left_span(opt_simple_name2),
  2000.               get_right_span(opt_simple_name2));
  2001.         NN(AS_PACKAGE_BODY);
  2002.         NAST4(simple_name1,decl_part,opt_node,opt_node);
  2003.         nodefree(opt_simple_name2);
  2004. #undef simple_name1
  2005. #undef decl_part
  2006. #undef opt_simple_name2
  2007.  
  2008.         break;
  2009.         /* package_body ::=
  2010.             PACKAGE BODY package_simple_name IS declarative_part BEG */
  2011.     case 194 :
  2012. #define simple_name1 AST(2)
  2013. #define decl_part AST(4)
  2014. #define stmts AST(6)
  2015. #define opt_except_list AST(7)
  2016. #define opt_simple_name2 AST(9)
  2017.         {
  2018.             struct ast *labs_node;
  2019.  
  2020.             if (opt_simple_name2 != opt_node
  2021.               && simple_name1->links.val != opt_simple_name2->links.val)
  2022.                 match_error(simple_name1->links.val,opt_simple_name2->links.val,
  2023.                   "package_body",get_left_span(opt_simple_name2),
  2024.                   get_right_span(opt_simple_name2));
  2025.             labs_node = new_node(AS_LABELS);
  2026.             labs_node->links.list = remove_duplicate_labels(
  2027.               concatl(copylist(getlabels(stmts)),
  2028.               ((opt_except_list == opt_node) ? (struct two_pool *)0 : 
  2029.               copylist(getlabels(opt_except_list)))));
  2030.             append(decl_part,labs_node);
  2031.             NN(AS_PACKAGE_BODY);
  2032.             NAST4(simple_name1,decl_part,stmts,opt_except_list);
  2033.             nodefree(opt_simple_name2);
  2034.         }
  2035. #undef simple_name1
  2036. #undef decl_part
  2037. #undef stmts
  2038. #undef opt_except_list
  2039. #undef opt_simple_name2
  2040.  
  2041.         break;
  2042.         /* private_type_declaration ::=
  2043.             TYPE identifier [discriminant_part]IS [LIMIT */
  2044.     case 195 :
  2045. #define opt_discr_part AST(2)
  2046. #define opt_limited AST(3)
  2047.         {
  2048.             struct ast *kind_node;
  2049.  
  2050.             make_id(1);
  2051.             kind_node = new_node(AS_SIMPLE_NAME);
  2052.             kind_node->links.val =
  2053.               (opt_limited == opt_node) ? namemap("private",7) :
  2054.               namemap("limited_private",15);
  2055.             set_span(kind_node,
  2056.               (opt_limited==opt_node ? LOC(4) : &opt_limited->span));
  2057.             NN(AS_PRIVATE_DECL);
  2058.             NAST3(id_node,opt_discr_part,kind_node);
  2059.         }
  2060. #undef opt_discr_part
  2061. #undef opt_limited
  2062.  
  2063.         break;
  2064.         /* use_clause ::= USE package_name {,package_name} ; */
  2065.     case 196 :
  2066. #define pack_name AST(1)
  2067.         node = AST(2);
  2068.         prepend(pack_name,node);
  2069.         node->kind = AS_USE;
  2070. #undef pack_name
  2071.  
  2072.         break;
  2073.         /* renaming_declaration ::= identifier:type_mark RENAMES object_name; */
  2074.     case 197 :
  2075. #define name AST(2)
  2076.         node = AST(0);
  2077.         (node->links.subast)[2] = name;
  2078. #undef name
  2079.  
  2080.         break;
  2081.         /* renaming_declaration ::=
  2082.             identifier:EXCEPTION RENAMES exception_name; */
  2083.     case 198 :
  2084. #define name AST(2)
  2085.         node = AST(0);
  2086.         (node->links.subast)[1] = name;
  2087. #undef name
  2088.  
  2089.         break;
  2090.         /* renaming_declaration ::= PACKAGE identifier RENAMES package_name ; */
  2091.     case 199 :
  2092. #define name AST(3)
  2093.         make_id(1);
  2094.         NN(AS_RENAME_PACK);
  2095.         NAST2(id_node,name);
  2096. #undef name
  2097.  
  2098.         break;
  2099.         /* renaming_declaration ::=
  2100.             subprogram_specification RENAMES subprogram_or_e */
  2101.     case 200 :
  2102. #define sub_spec AST(0)
  2103. #define name AST(2)
  2104.         NN(AS_RENAME_SUB);
  2105.         NAST2(sub_spec,name);
  2106. #undef sub_spec
  2107. #undef name
  2108.  
  2109.         break;
  2110.         /* task_declaration ::= task_specification ; */
  2111.     case 201 :
  2112.         node = AST(0);
  2113.  
  2114.         break;
  2115.         /* task_specification ::= TASK [TYPE] identifier */
  2116.     case 202 :
  2117. #define opt_type AST(1)
  2118.         {
  2119.             struct ast *entry_decl_list, *repr_clause_list;
  2120.  
  2121.             make_id(2);
  2122.             NN((opt_type == opt_node) ? AS_TASK_SPEC :
  2123.               AS_TASK_TYPE_SPEC);
  2124.             entry_decl_list = new_node(AS_LIST);
  2125.             repr_clause_list = new_node(AS_LIST);
  2126.             entry_decl_list->links.list = NULL;
  2127.             repr_clause_list->links.list = NULL;
  2128.             set_span(entry_decl_list,&curtok->ptr.token->loc);
  2129.             set_span(repr_clause_list,&curtok->ptr.token->loc);
  2130.             NAST3(id_node,entry_decl_list,repr_clause_list);
  2131.         }
  2132. #undef opt_type
  2133.  
  2134.         break;
  2135.         /* task_specification ::=
  2136.             TASK [TYPE] identifier IS {entry_declaration} {rep */
  2137.     case 203 :
  2138. #define opt_type AST(1)
  2139. #define id IND(2)
  2140. #define entry_decl_list AST(4)
  2141. #define repr_clause_list AST(5)
  2142. #define opt_simple_name AST(7)
  2143.         if (opt_simple_name != opt_node && opt_simple_name->links.val != id)
  2144.             match_error(id,opt_simple_name->links.val,"task_specification",
  2145.               get_left_span(opt_simple_name),get_right_span(opt_simple_name));
  2146.         make_id(2);
  2147.         NN((opt_type == opt_node) ? AS_TASK_SPEC : AS_TASK_TYPE_SPEC);
  2148.         NAST3(id_node,entry_decl_list,repr_clause_list);
  2149.         ins_as_line_no(entry_decl_list);
  2150.         nodefree(opt_simple_name);
  2151. #undef id
  2152. #undef entry_decl_list
  2153. #undef repr_clause_list
  2154. #undef opt_simple_name
  2155.  
  2156.         break;
  2157.         /* task_body ::=
  2158.             TASK BODY task_simple_name IS declarative_part BEGIN sequen */
  2159.     case 204 :
  2160. #define simple_name1 AST(2)
  2161. #define decl_part AST(4)
  2162. #define stmts AST(6)
  2163. #define opt_except_list AST(7)
  2164. #define opt_simple_name2 AST(9)
  2165.         {
  2166.             struct ast *labs_node;
  2167.  
  2168.             if (opt_simple_name2 != opt_node
  2169.               && simple_name1->links.val != opt_simple_name2->links.val)
  2170.                 match_error(simple_name1->links.val,opt_simple_name2->links.val,
  2171.                   "task_body",get_left_span(opt_simple_name2),
  2172.                   get_right_span(opt_simple_name2));
  2173.             labs_node = new_node(AS_LABELS);
  2174.             labs_node->links.list = remove_duplicate_labels(
  2175.               concatl(copylist(getlabels(stmts)),
  2176.               ((opt_except_list == opt_node) ? (struct two_pool *)0 : 
  2177.               copylist(getlabels(opt_except_list)))));
  2178.             append(decl_part,labs_node);
  2179.             NN(AS_TASK);
  2180.             NAST4(simple_name1,decl_part,stmts,opt_except_list);
  2181.             nodefree(opt_simple_name2);
  2182.         }
  2183. #undef simple_name1
  2184. #undef decl_part
  2185. #undef stmts
  2186. #undef opt_except_list
  2187. #undef opt_simple_name2
  2188.  
  2189.         break;
  2190.         /* entry_declaration ::=
  2191.             ENTRY identifier [(discrete_range)][formal_part] ; */
  2192.     case 205 :
  2193.         node = AST(2);
  2194.         make_id(1);
  2195.         (node->links.subast)[0] = id_node;
  2196.  
  2197.         break;
  2198.         /* accept_statement ::=
  2199.             ACCEPT entry_simple_name [(entry_index)][formal_part */
  2200.     case 206 :
  2201. #define simple_name AST(1)
  2202.         node = AST(2);
  2203.         erase_labels(node);
  2204.         (node->links.subast)[0] = simple_name;
  2205.         (node->links.subast)[3] = opt_node;
  2206. #undef simple_name
  2207.  
  2208.         break;
  2209.         /* accept_statement ::=
  2210.             ACCEPT entry_simple_name [(entry_index)][formal_part */
  2211.     case 207 :
  2212. #define simple_name1 AST(1)
  2213. #define stmts AST(4)
  2214. #define opt_simple_name2 AST(6)
  2215.         node = AST(2);
  2216.         if (opt_simple_name2 != opt_node
  2217.           && simple_name1->links.val != opt_simple_name2->links.val)
  2218.             match_error(simple_name1->links.val,opt_simple_name2->links.val,
  2219.               "accept_statement",get_left_span(opt_simple_name2),
  2220.               get_right_span(opt_simple_name2));
  2221.         newlabels(node,copylist(getlabels(stmts)));
  2222.         (node->links.subast)[0] = simple_name1;
  2223.         (node->links.subast)[3] = stmts;
  2224.         nodefree(opt_simple_name2);
  2225. #undef simple_name1
  2226. #undef stmts
  2227. #undef opt_simple_name2
  2228.  
  2229.         /* entry_index ::= expression */
  2230.         /* case 208 : */
  2231.  
  2232.         break;
  2233.         /* delay_statement ::= DELAY simple_expression ; */
  2234.     case 209 :
  2235. #define simple_expr AST(1)
  2236.         NN(AS_DELAY);
  2237.         NAST1(simple_expr);
  2238. #undef simple_expr
  2239.  
  2240.         /* select_statement ::= selective_wait */
  2241.         /* case 210 : */
  2242.  
  2243.         /* select_statement ::= conditional_entry_call */
  2244.         /* case 211 : */
  2245.  
  2246.         /* select_statement ::= timed_entry_call */
  2247.         /* case 212 : */
  2248.  
  2249.         break;
  2250.         /* selective_wait ::=
  2251.             SELECT {pragma} select_alternative {OR__select_alterna */
  2252.     case 213 :
  2253. #define pragma_node AST(1)
  2254. #define alt AST(2)
  2255. #define alt_node AST(3)
  2256. #define opt_stmts AST(4)
  2257.         {
  2258.             struct two_pool *nodelabels = NULL;
  2259.             int delay_index = 0, terminate_index = 0, has_accept = 0, i = 0;
  2260.             int terminate_ct = 0;
  2261.             struct ast *delay_ptr = NULL, *terminate_ptr = NULL, *tmp_alt;
  2262.  
  2263.             NN(AS_SELECTIVE_WAIT);
  2264.             check_pragmas(pragma_node,null_pragmas);
  2265.             alt_node->links.list = concatl3(pragma_node->links.list,
  2266.               initlist(alt), alt_node->links.list);
  2267.             LLOOPTOP(alt_node->links.list,tmp)
  2268.                 nodelabels = concatl(nodelabels,
  2269.                   copylist(getlabels(tmp->val.node)));
  2270.             LLOOPBOTTOM(tmp)
  2271.             if (opt_stmts != opt_node)
  2272.               nodelabels = concatl(nodelabels,copylist(getlabels(opt_stmts)));
  2273.             newlabels(node,nodelabels);
  2274.             NAST2(alt_node,opt_stmts);
  2275.             nodefree(pragma_node);
  2276.  
  2277.             LLOOPTOP(alt_node->links.list,tmp)
  2278.                 i++;
  2279.                 if ((tmp_alt = tmp->val.node)->kind == AS_GUARD)
  2280.                     tmp_alt = (tmp_alt->links.subast)[1];
  2281.                 if (tmp_alt->kind == AS_DELAY_ALT) {
  2282.                     delay_index = i;
  2283.                     delay_ptr = tmp_alt;
  2284.                 }
  2285.                 else if (tmp_alt->kind == AS_TERMINATE_ALT) {
  2286.                     terminate_index = i;
  2287.                     terminate_ptr = tmp_alt;
  2288.                     if (++terminate_ct > 1)
  2289.                         syntax_err(SPAN(terminate_ptr),
  2290.              "Only one terminate alternative can appear in a SELECT statement");
  2291.                 }
  2292.                 else
  2293.                     has_accept = 1;
  2294.             LLOOPBOTTOM(tmp)
  2295.             if (delay_index && terminate_index) {
  2296.                 tmp_alt = (delay_index > terminate_index) ? delay_ptr : 
  2297.                   terminate_ptr;
  2298.                 syntax_err(SPAN(tmp_alt),
  2299. "Delay and terminate alternatives cannot appear in the same SELECT statement");
  2300.             }
  2301.             if ((delay_index || terminate_index) && opt_stmts != opt_node)
  2302.                 syntax_err(SPAN(opt_stmts),
  2303.         "ELSE part cannot appear in SELECT statement if delay or terminate \
  2304. alternatives are present");
  2305.  
  2306.             /* A selective_wait must contain at least one accept_alternative */
  2307.             if (!has_accept)
  2308.                 syntax_err(LOC(0),END_LOC(6),
  2309.                   "SELECT statement must have at least one ACCEPT alternative");
  2310.         }
  2311. #undef pragma_node
  2312. #undef alt
  2313. #undef alt_node
  2314. #undef opt_stmts
  2315.  
  2316.         break;
  2317.         /* select_alternative ::=
  2318.             [WHEN__condition=>] selective_wait_alternative */
  2319.     case 214 :
  2320. #define condition AST(0)
  2321. #define alt AST(1)
  2322.         if (condition == opt_node)
  2323.             node = alt;
  2324.         else {
  2325.             NN(AS_GUARD);
  2326.             newlabels(node,copylist(getlabels(alt)));
  2327.             NAST2(condition,alt);
  2328.         }
  2329. #undef condition
  2330. #undef alt
  2331.  
  2332.         /* selective_wait_alternative ::= accept_alternative */
  2333.         /* case 215 : */
  2334.  
  2335.         /* selective_wait_alternative ::= delay_alternative */
  2336.         /* case 216 : */
  2337.  
  2338.         /* selective_wait_alternative ::= terminate_alternative */
  2339.         /* case 217 : */
  2340.  
  2341.         break;
  2342.         /* accept_alternative ::= accept_statement [sequence_of_statements] */
  2343.     case 218 :
  2344. #define accept_stmt AST(0)
  2345. #define opt_stmts AST(1)
  2346.         NN(AS_ACCEPT_ALT);
  2347.         /*newlabels(node,concatl(copylist(getlabels(accept_stmt)),
  2348.         ((opt_stmts == opt_node) ? LASTARG : 
  2349.         copylist(getlabels(opt_stmts)))));*/
  2350.         if (opt_stmts!=opt_node) {
  2351.             newlabels(node,concatl(copylist(getlabels(accept_stmt)),
  2352.               copylist(getlabels(opt_stmts))));
  2353.         }
  2354.         else {
  2355.             newlabels(node,copylist(getlabels(accept_stmt)));
  2356.         }
  2357.         NAST2(accept_stmt,opt_stmts);
  2358. #undef accept_stmt
  2359. #undef opt_stmts
  2360.  
  2361.         break;
  2362.         /* delay_alternative ::= delay_statement [sequence_of_statements] */
  2363.     case 219 :
  2364. #define delay_stmt AST(0)
  2365. #define opt_stmts AST(1)
  2366.         NN(AS_DELAY_ALT);
  2367.         if (opt_stmts != opt_node)
  2368.             newlabels(node,copylist(getlabels(opt_stmts)));
  2369.         NAST2(delay_stmt,opt_stmts);
  2370. #undef delay_stmt
  2371. #undef opt_stmts
  2372.  
  2373.         break;
  2374.         /* terminate_alternative ::= TERMINATE ; {pragma} */
  2375.     case 220 :
  2376.         node = AST(2);
  2377.         check_pragmas(node,null_pragmas);
  2378.         erase_labels(node);
  2379.         node->kind = AS_TERMINATE_ALT;
  2380.  
  2381.         break;
  2382.         /* conditional_entry_call ::=
  2383.             SELECT {pragma} call_statement [sequence_of_st */
  2384.     case 221 :
  2385. #define pragma_node AST(1)
  2386. #define call_stmt AST(2)
  2387. #define opt_stmts AST(3)
  2388. #define else_stmts AST(5)
  2389.         NN(AS_CONDITIONAL_ENTRY_CALL);
  2390.         check_pragmas(pragma_node,null_pragmas);
  2391.         pragmalist_warning(pragma_node);
  2392.         newlabels(node,concatl(((opt_stmts == opt_node) ? (struct two_pool *)0 :
  2393.           copylist(getlabels(opt_stmts))),copylist(getlabels(else_stmts))));
  2394.         NAST3(call_stmt,opt_stmts,else_stmts);
  2395.         free_everything(pragma_node);
  2396. #undef pragma_node
  2397. #undef call_stmt
  2398. #undef opt_stmts
  2399. #undef else_stmts
  2400.  
  2401.         break;
  2402.         /* timed_entry_call ::=
  2403.             SELECT {pragma} call_statement [sequence_of_statemen */
  2404.     case 222 :
  2405. #define pragma_node1 AST(1)
  2406. #define call_stmt AST(2)
  2407. #define opt_stmts AST(3)
  2408. #define pragma_node2 AST(5)
  2409. #define delay_alt AST(6)
  2410.         NN(AS_TIMED_ENTRY_CALL);
  2411.         check_pragmas(pragma_node1,null_pragmas);
  2412.         check_pragmas(pragma_node2,null_pragmas);
  2413.         pragmalist_warning(pragma_node1);
  2414.         pragmalist_warning(pragma_node2);
  2415.         newlabels(node,concatl(((opt_stmts == opt_node) ? (struct two_pool *)0 :
  2416.           copylist(getlabels(opt_stmts))),copylist(getlabels(delay_alt))));
  2417.         free_everything(pragma_node1);
  2418.         free_everything(pragma_node2);
  2419.         NAST3(call_stmt,opt_stmts,delay_alt);
  2420. #undef pragma_node1
  2421. #undef call_stmt
  2422. #undef opt_stmts
  2423. #undef pragma_node2
  2424. #undef delay_alt
  2425.  
  2426.         break;
  2427.         /* abort_statement ::= ABORT task_name {,task_name} ; */
  2428.     case 223 :
  2429. #define name AST(1)
  2430.         node = AST(2);
  2431.         prepend(name,node);
  2432.         node->kind = AS_ABORT;
  2433. #undef name
  2434.  
  2435.         /* compilation ::= {compilation_unit} */
  2436.         /* case 224 : */
  2437.  
  2438.         break;
  2439.         /* compilation_unit ::= context_clause library_unit */
  2440.     case 225 :
  2441. #define context_clause AST(0)
  2442. #define library_unit AST(1)
  2443.         NN(AS_UNIT);
  2444.         NAST2(context_clause,library_unit);
  2445. #undef context_clause
  2446. #undef library_unit
  2447.  
  2448.         break;
  2449.         /* compilation_unit ::= context_clause secondary_unit */
  2450.     case 226 :
  2451. #define context_clause AST(0)
  2452. #define secondary_unit AST(1)
  2453.         NN(AS_UNIT);
  2454.         NAST2(context_clause,secondary_unit);
  2455. #undef context_clause
  2456. #undef secondary_unit
  2457.  
  2458.         /* library_unit ::= subprogram_declaration */
  2459.         /* case 227 : */
  2460.  
  2461.         /* library_unit ::= package_declaration */
  2462.         /* case 228 : */
  2463.  
  2464.         /* library_unit ::= generic_declaration */
  2465.         /* case 229 : */
  2466.  
  2467.         /* library_unit ::= generic_instantiation */
  2468.         /* case 230 : */
  2469.  
  2470.         /* library_unit ::= subprogram_body */
  2471.         /* case 231 : */
  2472.  
  2473.         /* secondary_unit ::= library_unit_body */
  2474.         /* case 232 : */
  2475.  
  2476.         /* secondary_unit ::= subunit */
  2477.         /* case 233 : */
  2478.  
  2479.         /* library_unit_body ::= package_body */
  2480.         /* case 234 : */
  2481.  
  2482.         /* context_clause ::= {with_clause{use_clause}} */
  2483.         /* case 235 : */
  2484.  
  2485.         break;
  2486.         /* with_clause ::= WITH unit_simple_name {,unit_simple_name} ; */
  2487.     case 236 :
  2488. #define simple_name AST(1)
  2489.         node = AST(2);
  2490.         prepend(simple_name,node);
  2491.         node->kind = AS_WITH;
  2492. #undef simple_name
  2493.  
  2494.         break;
  2495.         /* body_stub ::= subprogram_specification IS SEPARATE ; */
  2496.     case 237 :
  2497. #define sub_spec AST(0)
  2498.         NN(AS_SUBPROGRAM_STUB);
  2499.         NAST1(sub_spec);
  2500. #undef sub_spec
  2501.  
  2502.         break;
  2503.         /* body_stub ::= PACKAGE BODY package_simple_name IS SEPARATE ; */
  2504.     case 238 :
  2505.         node = AST(2);
  2506.         node->kind = AS_PACKAGE_STUB;
  2507.  
  2508.         break;
  2509.         /* body_stub ::= TASK BODY task_simple_name IS SEPARATE ; */
  2510.     case 239 :
  2511.         node = AST(2);
  2512.         node->kind = AS_TASK_STUB;
  2513.  
  2514.         break;
  2515.         /* subunit ::= SEPARATE ( parent_unit_name ) proper_body */
  2516.     case 240 :
  2517. #define name AST(2)
  2518. #define body AST(4)
  2519.         NN(AS_SEPARATE);
  2520.         NAST2(name,body);
  2521. #undef name
  2522. #undef body
  2523.  
  2524.         break;
  2525.         /* exception_declaration ::= identifier_list : EXCEPTION ; */
  2526.     case 241 :
  2527.         node = AST(0);
  2528.         node->kind = AS_EXCEPT_DECL;
  2529.  
  2530.         break;
  2531.         /* exception_handler ::=
  2532.             WHEN exception_choice {|exception_choice} => sequen */
  2533.     case 242 :
  2534. #define choice AST(1)
  2535. #define choice_node AST(2)
  2536. #define stmts AST(4)
  2537.         NN(AS_HANDLER);
  2538.         prepend(choice,choice_node);
  2539.         newlabels(node,copylist(getlabels(stmts)));
  2540.         NAST2(choice_node,stmts);
  2541. #undef choice
  2542. #undef choice_node
  2543. #undef stmts
  2544.  
  2545.         /* exception_choice ::= exception_name */
  2546.         /* case 243 : */
  2547.  
  2548.         break;
  2549.         /* exception_choice ::= OTHERS */
  2550.     case 244 :
  2551.         NN(AS_OTHERS);
  2552.         set_span(node,LOC(0));
  2553.  
  2554.         break;
  2555.         /* raise_statement ::= RAISE [exception_name] ; */
  2556.     case 245 :
  2557. #define opt_name AST(1)
  2558.         {
  2559.             struct ast *span_node;
  2560.  
  2561.             NN(AS_RAISE);
  2562.             span_node = new_node(AS_SIMPLE_NAME);
  2563.             span_node->links.val = IND(0);
  2564.             set_span(span_node,LOC(0));
  2565.             NAST2(opt_name,span_node);
  2566.         }
  2567. #undef opt_name
  2568.  
  2569.         break;
  2570.         /* generic_declaration ::= generic_specification ; */
  2571.     case 246 :
  2572.         node = AST(0);
  2573.  
  2574.         break;
  2575.         /* generic_specification ::=
  2576.             generic_formal_part subprogram_specification */
  2577.     case 247 :
  2578. #define generic_part AST(0)
  2579. #define sub_spec AST(1)
  2580. #define id_node (sub_spec->links.subast)[0]
  2581. #define formals (sub_spec->links.subast)[1]
  2582. #define ret (sub_spec->links.subast)[2]
  2583.         if (sub_spec->kind == AS_FUNCTION) {
  2584.             if (id_node->kind == AS_OPERATOR)
  2585.                 syntax_err(SPAN(id_node),
  2586.                   "Operator symbol invalid in Generic specification");
  2587.             NN(AS_GENERIC_FUNCTION);
  2588.             NAST4(id_node,generic_part,formals,ret);
  2589.         }
  2590.         else {
  2591.             NN(AS_GENERIC_PROCEDURE);
  2592.             NAST4(id_node,generic_part,formals,opt_node);
  2593.         }
  2594.         astfree(sub_spec->links.subast);
  2595.         nodefree(sub_spec);
  2596. #undef generic_part
  2597. #undef sub_spec
  2598. #undef id_node
  2599. #undef formals
  2600. #undef ret
  2601.  
  2602.         break;
  2603.         /* generic_specification ::= generic_formal_part package_specification*/
  2604.     case 248 :
  2605. #define generic_part AST(0)
  2606. #define pack_spec AST(1)
  2607. #define id_node (pack_spec->links.subast)[0]
  2608. #define decls (pack_spec->links.subast)[1]
  2609. #define opt_priv_part (pack_spec->links.subast)[2]
  2610.         NN(AS_GENERIC_PACKAGE);
  2611.         NAST4(id_node,generic_part,decls,opt_priv_part);
  2612.         astfree(pack_spec->links.subast);
  2613.         nodefree(pack_spec);
  2614. #undef generic_part
  2615. #undef pack_spec
  2616. #undef id_node
  2617. #undef decls
  2618. #undef opt_priv_part
  2619.  
  2620.         break;
  2621.         /* generic_formal_part ::= GENERIC {generic_parameter_declaration} */
  2622.     case 249 :
  2623.         node = AST(1);
  2624.         node->kind = AS_GENERIC_FORMALS;
  2625.  
  2626.         break;
  2627.         /* generic_parameter_declaration ::=
  2628.             identifier_list : [IN[OUT]] type_mark [ */
  2629.     case 250 :
  2630. #define id_list AST(0)
  2631. #define ast_mode AST(2)
  2632. #define type_mark AST(3)
  2633. #define opt_init AST(4)
  2634.         NN(AS_GENERIC_OBJ);
  2635.         NAST4(id_list,ast_mode,type_mark,opt_init);
  2636. #undef id_list
  2637. #undef ast_mode
  2638. #undef type_mark
  2639. #undef opt_init
  2640.  
  2641.         break;
  2642.         /* generic_parameter_declaration ::=
  2643.             TYPE identifier IS generic_type_definit */
  2644.     case 251 :
  2645. #define type_def AST(3)
  2646.         make_id(1);
  2647.         NN(AS_GENERIC_TYPE);
  2648.         NAST3(id_node,opt_node,type_def);
  2649. #undef type_def
  2650.  
  2651.         break;
  2652.         /* generic_parameter_declaration ::= private_type_declaration */
  2653.     case 252 :
  2654.         node = AST(0);
  2655.         node->kind = AS_GEN_PRIV_TYPE;
  2656.  
  2657.         break;
  2658.         /* generic_parameter_declaration ::=
  2659.             WITH subprogram_specification [IS__name */
  2660.     case 253 :
  2661. #define sub_spec AST(1)
  2662. #define opt_is_part AST(2)
  2663.         NN(AS_GENERIC_SUBP);
  2664.         NAST2(sub_spec,opt_is_part);
  2665. #undef sub_spec
  2666. #undef opt_is_part
  2667.  
  2668.         break;
  2669.         /* generic_type_definition ::= ( <> ) */
  2670.     case 254 :
  2671.         NN(AS_GENERIC);
  2672.         node->links.val = namemap("discrete_type",13);
  2673.         set_span(node,LOC(0));
  2674.  
  2675.         break;
  2676.         /* generic_type_definition ::= RANGE <> */
  2677.     case 255 :
  2678.         NN(AS_GENERIC);
  2679.         node->links.val = namemap("INTEGER",7);
  2680.         set_span(node,LOC(0));
  2681.  
  2682.         break;
  2683.         /* generic_type_definition ::= DIGITS <> */
  2684.     case 256 :
  2685.         NN(AS_GENERIC);
  2686.         node->links.val = namemap("FLOAT",5);
  2687.         set_span(node,LOC(0));
  2688.  
  2689.         break;
  2690.         /* generic_type_definition ::= DELTA <> */
  2691.     case 257 :
  2692.         NN(AS_GENERIC);
  2693.         node->links.val = namemap("$FIXED",6);
  2694.         set_span(node,LOC(0));
  2695.  
  2696.         /* generic_type_definition ::= array_type_definition */
  2697.         /* case 258 : */
  2698.  
  2699.         /* generic_type_definition ::= access_type_definition */
  2700.         /* case 259 : */
  2701.  
  2702.         break;
  2703.         /* generic_instantiation ::=
  2704.             PACKAGE identifier IS NEW generic_package_name  */
  2705.     case 260 :
  2706. #define pack_name AST(4)
  2707. #define actual_part AST(5)
  2708.         make_id(1);
  2709.         NN(AS_PACKAGE_INSTANCE);
  2710.         NAST3(id_node,pack_name,actual_part);
  2711. #undef pack_name
  2712. #undef actual_part
  2713.  
  2714.         break;
  2715.         /* generic_instantiation ::=
  2716.             FUNCTION designator IS NEW generic_function_nam */
  2717.     case 261 :
  2718. #define desig AST(1)
  2719. #define func_name AST(4)
  2720. #define actual_part AST(5)
  2721.         NN(AS_FUNCTION_INSTANCE);
  2722.         NAST3(desig,func_name,actual_part);
  2723. #undef desig
  2724. #undef func_name
  2725. #undef actual_part
  2726.  
  2727.         break;
  2728.         /* generic_instantiation ::=
  2729.             subprogram_specification IS NEW generic_procedu */
  2730.     case 262 :
  2731. #define sub_spec AST(0)
  2732. #define proc_name AST(3)
  2733. #define actual_part AST(4)
  2734. #define id (sub_spec->links.subast)[0]
  2735. #define opt_formal (sub_spec->links.subast)[1]
  2736.         if (sub_spec->kind != AS_PROCEDURE)
  2737.             syntax_err(SPAN(sub_spec),"Bad generic procedure instantiation");
  2738.         if (opt_formal != opt_node)
  2739.             syntax_err(SPAN(sub_spec),
  2740.               "formal_part not allowed in procedure instantiation");
  2741.         NN(AS_PROCEDURE_INSTANCE);
  2742.         NAST3(id,proc_name,actual_part);
  2743.         FREEAST(sub_spec,1);
  2744.         astfree(sub_spec->links.subast);
  2745.         nodefree(sub_spec);
  2746. #undef sub_spec
  2747. #undef proc_name
  2748. #undef actual_part
  2749. #undef id
  2750. #undef opt_formal
  2751.  
  2752.         break;
  2753.         /* generic_actual_part ::=
  2754.             ( generic_association {,generic_association} ) */
  2755.     case 263 :
  2756. #define assoc AST(1)
  2757.         node = AST(2);
  2758.         prepend(assoc,node);
  2759. #undef assoc
  2760.  
  2761.         /* generic_association ::=
  2762.             [generic_formal_parameter=>]generic_actual_parame */
  2763.         /* case 264 : */
  2764.  
  2765.         /* generic_formal_parameter ::= parameter_simple_name */
  2766.         /* case 265 : */
  2767.  
  2768.         break;
  2769.         /* generic_formal_parameter ::= operator_symbol */
  2770.     case 266 :
  2771.         {
  2772.             char tmp[MAXLINE + 1];
  2773.  
  2774.             node = AST(0);
  2775.             strcpy(tmp,namelist(node->links.val));
  2776.             convtolower(tmp);
  2777.             if (!isoverloadable_op(tmp)) {
  2778.                 char msg[MAXLINE + 30];
  2779.  
  2780.                 sprintf(msg,"\"%s\" is not a valid operator_symbol",tmp);
  2781.                 syntax_err(get_left_span(node),get_right_span(node),msg);
  2782.             }
  2783.             node->links.val = namemap(tmp,strlen(tmp));
  2784.         }
  2785.  
  2786.         /* generic_actual_parameter ::= expression */
  2787.         /* case 267 : */
  2788.  
  2789.         break;
  2790.         /* representation_clause ::= type_representation_clause */
  2791.     case 268 :
  2792.         node = AST(0);
  2793.         break;
  2794.         /* representation_clause ::= address_clause */
  2795.     case 269 :
  2796.         node = AST(0);
  2797.         syntax_err(SPAN(node),"address_clause not supported");
  2798.  
  2799.         /* type_representation_clause ::= length_clause */
  2800.         /* case 270 : */
  2801.  
  2802.         /* type_representation_clause ::= enumeration_representation_clause */
  2803.         /* case 271 : */
  2804.  
  2805.         /* type_representation_clause ::= record_representation_clause */
  2806.         /* case 272 : */
  2807.  
  2808.         break;
  2809.         /* length_clause ::= FOR attribute USE simple_expression ; */
  2810.     case 273 :
  2811. #define attribute AST(1)
  2812. #define simple_expr AST(3)
  2813.         NN(AS_LENGTH_CLAUSE);
  2814.         NAST2(attribute,simple_expr);
  2815. #undef attribute
  2816. #undef simple_expr
  2817.  
  2818.         break;
  2819.         /* enumeration_representation_clause ::=
  2820.             FOR type_simple_name USE aggregate  */
  2821.     case 274 :
  2822. #define simple_name AST(1)
  2823. #define aggregate AST(3)
  2824.         NN(AS_ENUM_REP_CLAUSE);
  2825.         NAST2(simple_name,aggregate);
  2826. #undef simple_name
  2827. #undef aggregate
  2828.  
  2829.         break;
  2830.         /* record_representation_clause ::=
  2831.             FOR type_simple_name USE RECORD [alignme */
  2832.     case 275 :
  2833. #define simple_name AST(1)
  2834. #define opt_align_clause AST(4)
  2835. #define comp_clause_list AST(5)
  2836.         NN(AS_REC_REP_CLAUSE);
  2837.         NAST3(simple_name,opt_align_clause,comp_clause_list);
  2838. #undef simple_name
  2839. #undef opt_align_clause
  2840. #undef comp_clause_list
  2841.  
  2842.         break;
  2843.         /* alignment_clause ::= AT MOD static_simple_expression ; */
  2844.     case 276 :
  2845.         node = AST(2);
  2846.  
  2847.         break;
  2848.         /* component_clause ::=
  2849.             component_name AT static_simple_expression RANGE sta */
  2850.     case 277 :
  2851. #define name AST(0)
  2852. #define simple_expr AST(2)
  2853. #define ast_range AST(4)
  2854.         NN(AS_COMPON_CLAUSE);
  2855.         if(ast_range->kind != AS_RANGE && ast_range->kind != AS_RANGE_ATTRIBUTE)
  2856.             syntax_err(SPAN(ast_range),"Invalid range specification");
  2857.         NAST3(name,simple_expr,ast_range);
  2858. #undef name
  2859. #undef simple_expr
  2860. #undef ast_range
  2861.  
  2862.         break;
  2863.         /* address_clause ::= FOR simple_name USE AT simple_expression ; */
  2864.     case 278 :
  2865. #define simple_name AST(1)
  2866. #define simple_expr AST(4)
  2867.         NN(AS_ADDRESS_CLAUSE);
  2868.         NAST2(simple_name,simple_expr);
  2869. #undef simple_name
  2870. #undef simple_expr
  2871.  
  2872.         break;
  2873.         /* code_statement ::= name ' record_aggregate ; */
  2874.     case 279 :
  2875. #define name AST(0)
  2876. #define aggregate AST(2)
  2877.         if (!check_expanded_name(name))
  2878.             syntax_err(SPAN(name),"Invalid type_mark in code statement");
  2879.         NN(AS_CODE);
  2880.         NAST2(name,aggregate);
  2881. #undef name
  2882. #undef aggregate
  2883.  
  2884.  
  2885.         break;
  2886.         /* {PRAGMA} ::= empty */
  2887.     case 280 :
  2888.         NN(AS_LIST);
  2889.         node->links.list = NULL;
  2890.         set_span(node,&curtok->ptr.token->loc);
  2891.  
  2892.         break;
  2893.         /* {PRAGMA} ::= {pragma} pragma */
  2894.     case 281 :
  2895. #define pragma AST(1)
  2896.         node = AST(0);
  2897.         if (pragma != any_node)
  2898.             append(node,pragma);
  2899. #undef pragma
  2900.  
  2901.  
  2902.         break;
  2903.         /* [(argument_association{,argument_association})] ::= empty */
  2904.     case 282 :
  2905.         node = opt_node;
  2906.         set_span(node,&curtok->ptr.token->loc);
  2907.  
  2908.         break;
  2909.         /* [(argument_association{,argument_association})] ::=
  2910.             ( argument_associatio */
  2911.     case 283 :
  2912.         node = AST(1);
  2913.  
  2914.         break;
  2915.         /* argument_association_list ::= argument_association */
  2916.     case 284 :
  2917. #define arg_assoc AST(0)
  2918.         NN(AS_ARG_ASSOC_LIST);
  2919.         node->links.list = initlist(arg_assoc);
  2920. #undef arg_assoc
  2921.  
  2922.         break;
  2923.         /* argument_association_list ::=
  2924.             argument_association_list , argument_associ */
  2925.     case 285 :
  2926. #define arg_assoc AST(2)
  2927.         node = AST(0);
  2928.         append(node,arg_assoc);
  2929. #undef arg_assoc
  2930.  
  2931.         break;
  2932.         /* [argument_identifier=>]expression ::= expression */
  2933.     case 286 :
  2934. #define expression AST(0)
  2935.         NN(AS_ARG);
  2936.         NAST2(opt_node,expression);
  2937. #undef expression
  2938.  
  2939.         break;
  2940.         /* [argument_identifier=
  2941.             ]expression ::= argument_identifier => expression */
  2942.     case 287 :
  2943.  
  2944. #define expression AST(2)
  2945.         make_id(0);
  2946.         NN(AS_ARG);
  2947.         NAST2(id_node,expression);
  2948. #undef expression
  2949.  
  2950.  
  2951.         break;
  2952.         /* [:=expression] ::= empty */
  2953.     case 288 :
  2954.         node = opt_node;
  2955.         set_span(node,&curtok->ptr.token->loc);
  2956.  
  2957.         break;
  2958.         /* [:=expression] ::= := expression */
  2959.     case 289 :
  2960.         node = AST(1);
  2961.  
  2962.  
  2963.         break;
  2964.         /* [CONSTANT] ::= empty */
  2965.     case 290 :
  2966.         node = opt_node;
  2967.         set_span(node,&curtok->ptr.token->loc);
  2968.  
  2969.         break;
  2970.         /* [CONSTANT] ::= CONSTANT */
  2971.     case 291 :
  2972.         node = any_node;
  2973.  
  2974.  
  2975.         break;
  2976.         /* {,identifier} ::= empty */
  2977.     case 292 :
  2978.         NN(AS_LIST);
  2979.         node->links.list = NULL;
  2980.         set_span(node,&curtok->ptr.token->loc);
  2981.  
  2982.         break;
  2983.         /* {,identifier} ::= {,identifier} , identifier */
  2984.     case 293 :
  2985.         node = AST(0);
  2986.         make_id(2);
  2987.         append(node,id_node);
  2988.  
  2989.  
  2990.         break;
  2991.         /* [discriminant_part]IS ::= IS */
  2992.     case 294 :
  2993.         node = opt_node;
  2994.         set_span(node,&curtok->ptr.token->loc);
  2995.  
  2996.         break;
  2997.         /* [discriminant_part]IS ::= discriminant_part IS */
  2998.     case 295 :
  2999.         node = AST(0);
  3000.  
  3001.  
  3002.         break;
  3003.         /* [constraint] ::= empty */
  3004.     case 296 :
  3005.         node = opt_node;
  3006.         set_span(node,&curtok->ptr.token->loc);
  3007.  
  3008.         /* [constraint] ::= constraint */
  3009.         /* case 297 : */
  3010.  
  3011.         break;
  3012.         /* expanded_name ::= identifier */
  3013.     case 298 :
  3014. #define id IND(0)
  3015.         NN(AS_SIMPLE_NAME);
  3016.         node->links.val = id;
  3017.         set_span(node,LOC(0));
  3018. #undef id
  3019.  
  3020.         break;
  3021.         /* expanded_name ::= expanded_name . identifier */
  3022.     case 299 :
  3023. #define expanded_name AST(0)
  3024.         make_id(2);
  3025.         NN(AS_SELECTOR);
  3026.         NAST2(expanded_name,id_node);
  3027. #undef expanded_name
  3028.  
  3029.  
  3030.         break;
  3031.         /* {,enumeration_literal_specification} ::= empty */
  3032.     case 300 :
  3033.         NN(AS_LIST);
  3034.         node->links.list = NULL;
  3035.         set_span(node,&curtok->ptr.token->loc);
  3036.  
  3037.         break;
  3038.         /* {,enumeration_literal_specification} ::=
  3039.             {,enumeration_literal_specificat */
  3040.     case 301 :
  3041. #define enum_lit AST(2)
  3042.         node = AST(0);
  3043.         append(node,enum_lit);
  3044. #undef enum_lit
  3045.  
  3046.  
  3047.         break;
  3048.         /* [range_constraint] ::= empty */
  3049.     case 302 :
  3050.         node = opt_node;
  3051.         set_span(node,&curtok->ptr.token->loc);
  3052.  
  3053.         /* [range_constraint] ::= range_constraint */
  3054.         /* case 303 : */
  3055.  
  3056.  
  3057.         break;
  3058.         /* {,index_subtype_definition} ::= empty */
  3059.     case 304 :
  3060.         NN(AS_LIST);
  3061.         node->links.list = NULL;
  3062.         set_span(node,&curtok->ptr.token->loc);
  3063.  
  3064.         break;
  3065.         /* {,index_subtype_definition} ::=
  3066.             {,index_subtype_definition} , index_subty */
  3067.     case 305 :
  3068. #define ndex AST(2)
  3069.         node = AST(0);
  3070.         append(node,ndex);
  3071. #undef ndex
  3072.  
  3073.  
  3074.         break;
  3075.         /* {,discrete_range} ::= empty */
  3076.     case 306 :
  3077.         NN(AS_LIST);
  3078.         node->links.list = NULL;
  3079.         set_span(node,&curtok->ptr.token->loc);
  3080.  
  3081.         break;
  3082.         /* {,discrete_range} ::= {,discrete_range} , discrete_range */
  3083.     case 307 :
  3084. #define discrete_range AST(2)
  3085.         node = AST(0);
  3086.         append(node,discrete_range);
  3087. #undef discrete_range
  3088.  
  3089.  
  3090.         break;
  3091.         /* {component_declaration} ::= empty */
  3092.     case 308 :
  3093.         NN(AS_LIST);
  3094.         node->links.list = NULL;
  3095.         set_span(node,&curtok->ptr.token->loc);
  3096.  
  3097.         break;
  3098.         /* {component_declaration} ::=
  3099.             {component_declaration} component_declaration */
  3100.     case 309 :
  3101. #define comp_dec AST(1)
  3102. #define pragma_node AST(2)
  3103.         node = AST(0);
  3104.         check_pragmas(pragma_node,null_pragmas);
  3105.         node->links.list = concatl3(node->links.list,initlist(comp_dec),
  3106.           pragma_node->links.list);
  3107.         nodefree(pragma_node);
  3108. #undef comp_dec
  3109. #undef pragma_node    
  3110.  
  3111.  
  3112.         break;
  3113.         /* {;discriminant_specification} ::= empty */
  3114.     case 310 :
  3115.         NN(AS_LIST);
  3116.         node->links.list = NULL;
  3117.         set_span(node,&curtok->ptr.token->loc);
  3118.  
  3119.         break;
  3120.         /* {;discriminant_specification} ::=
  3121.             {;discriminant_specification} ; discrim */
  3122.     case 311 :
  3123. #define discr_spec AST(2)
  3124.         node = AST(0);
  3125.         append(node,discr_spec);
  3126. #undef discr_spec
  3127.  
  3128.  
  3129.         break;
  3130.         /* {variant} ::= empty */
  3131.     case 312 :
  3132.         NN(AS_LIST);
  3133.         node->links.list = NULL;
  3134.         set_span(node,&curtok->ptr.token->loc);
  3135.  
  3136.         break;
  3137.         /* {variant} ::= {variant} variant */
  3138.     case 313 :
  3139. #define variant AST(1)
  3140.         node = AST(0);
  3141.         append(node,variant);
  3142. #undef variant
  3143.  
  3144.         break;
  3145.         /* {|choice} ::= empty */
  3146.     case 314 :
  3147.         NN(AS_LIST);
  3148.         node->links.list = NULL;
  3149.         set_span(node,&curtok->ptr.token->loc);
  3150.  
  3151.         break;
  3152.         /* {|choice} ::= {|choice} '|' choice */
  3153.     case 315 :
  3154. #define choice AST(2)
  3155.         node = AST(0);
  3156.         append(node,choice);
  3157. #undef choice
  3158.  
  3159.  
  3160.         break;
  3161.         /* [discriminant_part]; ::= ; */
  3162.     case 316 :
  3163.         node = opt_node;
  3164.         set_span(node,&curtok->ptr.token->loc);
  3165.  
  3166.         break;
  3167.         /* [discriminant_part]; ::= discriminant_part ; */
  3168.     case 317 :
  3169.         node  = AST(0);
  3170.  
  3171.         break;
  3172.         /* {basic_declarative_item} ::= {pragma} */
  3173.     case 318 :
  3174. #define pragma_node AST(0)
  3175.         check_pragmas(pragma_node,immediate_decl_pragmas);
  3176.         node = pragma_node;
  3177. #undef pragma_node
  3178.  
  3179.         break;
  3180.         /* {basic_declarative_item} ::=
  3181.             {basic_declarative_item} basic_declarative_i */
  3182.     case 319 :
  3183. #define basic_decl AST(1)
  3184. #define pragma_node AST(2)
  3185.         node = AST(0);
  3186.         check_pragmas(pragma_node,immediate_decl_pragmas);
  3187.         node->links.list = concatl3(node->links.list,initlist(basic_decl),
  3188.           pragma_node->links.list);
  3189.         nodefree(pragma_node);
  3190. #undef basic_decl
  3191. #undef pragma_node
  3192.  
  3193.  
  3194.         break;
  3195.         /* {,component_association} ::= empty */
  3196.     case 320 :
  3197.         NN(AS_LIST);
  3198.         node->links.list = NULL;
  3199.         set_span(node,&curtok->ptr.token->loc);
  3200.  
  3201.         break;
  3202.         /* {,component_association} ::=
  3203.             {,component_association} , component_associa */
  3204.     case 321 :
  3205. #define comp_assoc AST(2)
  3206.         node = AST(0);
  3207.         append(node,comp_assoc);
  3208. #undef comp_assoc
  3209.  
  3210.         /* [choice{|choice}=>]expression ::= expression */
  3211.         /* case 322 : */
  3212.  
  3213.         break;
  3214.         /* [choice{|choice}=>]expression ::= choice {|choice} => expression */
  3215.     case 323 :
  3216. #define choice AST(0)
  3217. #define choice_node AST(1)
  3218. #define expression AST(3)
  3219.         prepend(choice,choice_node);
  3220.         NN(AS_CHOICE_LIST);
  3221.         NAST2(choice_node,expression);
  3222. #undef choice
  3223. #undef choice_node
  3224. #undef expression
  3225.  
  3226.  
  3227.         break;
  3228.         /* {,general_component_association} ::= empty */
  3229.     case 324 :
  3230.         NN(AS_LIST);
  3231.         node->links.list = NULL;
  3232.         set_span(node,&curtok->ptr.token->loc);
  3233.  
  3234.         break;
  3235.         /* {,general_component_association} ::=
  3236.             {,general_component_association} , g */
  3237.     case 325 :
  3238. #define gen_comp_assoc AST(2)
  3239.         node = AST(0);
  3240.         append(node,gen_comp_assoc);
  3241. #undef gen_comp_assoc
  3242.  
  3243.         break;
  3244.         /* relation{AND__relation} ::= relation AND relation */
  3245.     case 326 :
  3246.  
  3247.         /* relation{AND__relation} ::= relation{AND__relation} AND relation */
  3248.     case 327 :
  3249.  
  3250.         /* relation{OR__relation} ::= relation OR relation */
  3251.     case 328 :
  3252.  
  3253.         /* relation{OR__relation} ::= relation{OR__relation} OR relation */
  3254.     case 329 :
  3255.  
  3256.         /* relation{XOR__relation} ::= relation XOR relation */
  3257.     case 330 :
  3258.  
  3259.         /* relation{XOR__relation} ::= relation{XOR__relation} XOR relation */
  3260.     case 331 :
  3261. #define relation1 AST(0)
  3262. #define relation2 AST(2)
  3263.         make_id(1);
  3264.         node = binary_operator(id_node,relation1,relation2);
  3265. #undef relation1
  3266. #undef relation2
  3267.  
  3268.         break;
  3269.         /* relation{AND__THEN__relation} ::= relation AND THEN relation */
  3270.     case 332 :
  3271.  
  3272.         /* relation{AND__THEN__relation} ::=
  3273.             relation{AND__THEN__relation} AND THEN  */
  3274.     case 333 :
  3275. #define relation1 AST(0)
  3276. #define relation2 AST(3)
  3277.         {
  3278.             struct ast *optr_node;
  3279.  
  3280.             optr_node = new_node(AS_SIMPLE_NAME);
  3281.             optr_node->links.val = namemap("andthen",7);
  3282.             set_span(optr_node,LOC(1));
  3283.             node = binary_operator(optr_node,relation1,relation2);
  3284.         }
  3285. #undef relation1
  3286. #undef relation2
  3287.  
  3288.         break;
  3289.         /* relation{OR__ELSE__relation} ::= relation OR ELSE relation */
  3290.     case 334 :
  3291.  
  3292.         /* relation{OR__ELSE__relation} ::=
  3293.             relation{OR__ELSE__relation} OR ELSE rel */
  3294.     case 335 :
  3295. #define relation1 AST(0)
  3296. #define relation2 AST(3)
  3297.         {
  3298.             struct ast *optr_node;
  3299.  
  3300.             optr_node = new_node(AS_SIMPLE_NAME);
  3301.             optr_node->links.val = namemap("orelse",6);
  3302.             set_span(optr_node,LOC(1));
  3303.             node = binary_operator(optr_node,relation1,relation2);
  3304.         }
  3305. #undef relation1
  3306. #undef relation2
  3307.  
  3308.  
  3309.         break;
  3310.         /* [relational_operator__simple_expression] ::= empty */
  3311.     case 336 :
  3312.         node = opt_node;
  3313.         set_span(node,&curtok->ptr.token->loc);
  3314.  
  3315.         break;
  3316.         /* [relational_operator__simple_expression] ::=
  3317.             relational_operator simple_e */
  3318.     case 337 :
  3319. #define optr AST(0)
  3320. #define simple_expr AST(1)
  3321.         node = binary_operator(optr,any_node,simple_expr);
  3322. #undef optr
  3323. #undef simple_expr
  3324.  
  3325.  
  3326.         break;
  3327.         /* [NOT] ::= empty */
  3328.     case 338 :
  3329.         node = opt_node;
  3330.         set_span(node,&curtok->ptr.token->loc);
  3331.  
  3332.         break;
  3333.         /* [NOT] ::= NOT */
  3334.     case 339 :
  3335.         node = any_node;
  3336.  
  3337.         /* [unary_adding_operator]term{binary_adding_operator__term} ::= term */
  3338.         /* case 340 : */
  3339.  
  3340.         break;
  3341.         /* [unary_adding_operator]term{binary_adding_operator__term} ::=
  3342.             unary_addin */
  3343.     case 341 :
  3344. #define optr AST(0)
  3345. #define ast_term AST(1)
  3346.         node = unary_operator(optr,ast_term);
  3347. #undef optr
  3348. #undef ast_term
  3349.  
  3350.         break;
  3351.         /* [unary_adding_operator]term{binary_adding_operator__term} ::=
  3352.             [unary_addi */
  3353.     case 342 :
  3354. #define expression AST(0)
  3355. #define optr AST(1)
  3356. #define ast_term AST(2)
  3357.         node = binary_operator(optr,expression,ast_term);
  3358. #undef expression
  3359. #undef optr
  3360. #undef ast_term
  3361.  
  3362.         /* factor{multiplying_operator__factor} ::= factor */
  3363.         /* case 343 : */
  3364.  
  3365.         break;
  3366.         /* factor{multiplying_operator__factor} ::=
  3367.             factor{multiplying_operator__fac */
  3368.     case 344 :
  3369. #define ast_term AST(0)
  3370. #define optr AST(1)
  3371. #define factor AST(2)
  3372.         node = binary_operator(optr,ast_term,factor);
  3373. #undef ast_term
  3374. #undef optr
  3375. #undef factor
  3376.  
  3377.  
  3378.         break;
  3379.         /* [**__primary] ::= empty */
  3380.     case 345 :
  3381.         node = opt_node;
  3382.         set_span(node,&curtok->ptr.token->loc);
  3383.  
  3384.         break;
  3385.         /* [**__primary] ::= ** primary */
  3386.     case 346 :
  3387. #define primary AST(1)
  3388.         make_id(0);
  3389.         node = binary_operator(id_node,any_node,primary);
  3390. #undef primary
  3391.  
  3392.         break;
  3393.         /* {statement} ::= {pragma} */
  3394.     case 347 :
  3395. #define pragma_node AST(0)
  3396.         check_pragmas(pragma_node,null_pragmas);
  3397.         node = pragma_node;
  3398. #undef pragma_node
  3399.  
  3400.         break;
  3401.         /* {statement} ::= {statement} statement {pragma} */
  3402.     case 348 :
  3403. #define stmt AST(1)
  3404. #define pragma_node AST(2)
  3405.         node = AST(0);
  3406.         check_pragmas(pragma_node,null_pragmas);
  3407.         node->links.list = concatl3(node->links.list,initlist(stmt),
  3408.           pragma_node->links.list);
  3409.         nodefree(pragma_node);
  3410. #undef stmt
  3411. #undef pragma_node
  3412.  
  3413.  
  3414.         break;
  3415.         /* {label} ::= empty */
  3416.     case 349 :
  3417.         NN(AS_LIST);
  3418.         node->links.list = NULL;
  3419.         set_span(node,&curtok->ptr.token->loc);
  3420.  
  3421.         break;
  3422.         /* {label} ::= {label} label */
  3423.     case 350 :
  3424. #define label AST(1)
  3425.         node = AST(0);
  3426.         append(node,label);
  3427. #undef label
  3428.  
  3429.  
  3430.         break;
  3431.         /* {ELSIF__condition__THEN__sequence_of_statements} ::= empty */
  3432.     case 351 :
  3433.         NN(AS_LIST);
  3434.         node->links.list = NULL;
  3435.         set_span(node,&curtok->ptr.token->loc);
  3436.  
  3437.         break;
  3438.         /* {ELSIF__condition__THEN__sequence_of_statements} ::=
  3439.             {ELSIF__condition__T */
  3440.     case 352 :
  3441. #define expression AST(2)
  3442. #define stmts AST(4)
  3443.         {
  3444.             struct ast *if_node;
  3445.  
  3446.             node = AST(0);
  3447.             if_node = new_node(AS_COND_STATEMENTS);
  3448.             if_node->links.subast = new_ast2(expression,stmts);
  3449.             append(node,if_node);
  3450.         }
  3451. #undef expression
  3452. #undef stmts
  3453.  
  3454.  
  3455.         break;
  3456.         /* [ELSE__sequence_of_statements] ::= empty */
  3457.     case 353 :
  3458.         node = opt_node;
  3459.         set_span(node,&curtok->ptr.token->loc);
  3460.  
  3461.         break;
  3462.         /* [ELSE__sequence_of_statements] ::= ELSE sequence_of_statements */
  3463.     case 354 :
  3464.         node = AST(1);
  3465.  
  3466.  
  3467.         break;
  3468.         /* {case_statement_alternative} ::= empty */
  3469.     case 355 :
  3470.         NN(AS_LIST);
  3471.         node->links.list = NULL;
  3472.         set_span(node,&curtok->ptr.token->loc);
  3473.  
  3474.         break;
  3475.         /* {case_statement_alternative} ::=
  3476.             {case_statement_alternative} case_statem */
  3477.     case 356 :
  3478. #define alt AST(1)
  3479.         node = AST(0);
  3480.         append(node,alt);
  3481. #undef alt
  3482.  
  3483.  
  3484.         break;
  3485.         /* [simple_name:] ::= empty */
  3486.     case 357 :
  3487.         node = opt_node;
  3488.         set_span(node,&curtok->ptr.token->loc);
  3489.  
  3490.         break;
  3491.         /* [simple_name:] ::= simple_name : */
  3492.     case 358 :
  3493.         node = AST(0);
  3494.  
  3495.  
  3496.         break;
  3497.         /* [simple_name] ::= empty */
  3498.     case 359 :
  3499.         node = opt_node;
  3500.         set_span(node,&curtok->ptr.token->loc);
  3501.  
  3502.         /* [simple_name] ::= simple_name */
  3503.         /* case 360 : */
  3504.  
  3505.  
  3506.         break;
  3507.         /* [iteration_scheme] ::= empty */
  3508.     case 361 :
  3509.         node = opt_node;
  3510.         set_span(node,&curtok->ptr.token->loc);
  3511.  
  3512.         /* [iteration_scheme] ::= iteration_scheme */
  3513.         /* case 362 : */
  3514.  
  3515.  
  3516.         break;
  3517.         /* [REVERSE] ::= empty */
  3518.     case 363 :
  3519.         node = opt_node;
  3520.         set_span(node,&curtok->ptr.token->loc);
  3521.  
  3522.         break;
  3523.         /* [REVERSE] ::= REVERSE */
  3524.     case 364 :
  3525.         node = any_node;
  3526.  
  3527.         break;
  3528.         /* [DECLARE__declarative_part] ::= empty */
  3529.     case 365 :
  3530.         NN(AS_DECLARATIONS);
  3531.         node->links.list = NULL;
  3532.  
  3533.         break;
  3534.         /* [DECLARE__declarative_part] ::= DECLARE declarative_part */
  3535.     case 366 :
  3536.         node = AST(1);
  3537.  
  3538.  
  3539.         break;
  3540.         /* [EXCEPTION__exception_handler{exception_handler}] ::= empty */
  3541.     case 367 :
  3542.         node = opt_node;
  3543.         set_span(node,&curtok->ptr.token->loc);
  3544.  
  3545.         break;
  3546.         /* [EXCEPTION__exception_handler{exception_handler}] ::=
  3547.             EXCEPTION {pragma}  */
  3548.     case 368 :
  3549. #define pragma_node AST(1)
  3550.         {
  3551.             struct two_pool *nodelabels = NULL;
  3552.  
  3553.             node = AST(2);
  3554.             check_pragmas(pragma_node,null_pragmas);
  3555.             LLOOPTOP(node->links.list,tmp)
  3556.                 nodelabels = concatl(nodelabels,
  3557.                   copylist(getlabels(tmp->val.node)));
  3558.             LLOOPBOTTOM(tmp)
  3559.                 newlabels(node,nodelabels);
  3560.             node->kind = AS_EXCEPTION;
  3561.             node->links.list =concatl(pragma_node->links.list,node->links.list);
  3562.             check_choices(node,"an exception_handler list");
  3563.             nodefree(pragma_node);
  3564.         }
  3565. #undef pragma_node
  3566.  
  3567.         break;
  3568.         /* exception_handler_list ::= exception_handler */
  3569.     case 369 :
  3570. #define except AST(0)
  3571.         NN(AS_LIST);
  3572.         node->links.list = initlist(except);
  3573. #undef except
  3574.  
  3575.         break;
  3576.         /* exception_handler_list ::= exception_handler_list exception_handler*/
  3577.     case 370 :
  3578. #define except AST(1)
  3579.         node = AST(0);
  3580.         append(node,except);
  3581. #undef except
  3582.  
  3583.  
  3584.         break;
  3585.         /* [expanded_name] ::= empty */
  3586.     case 371 :
  3587.         node = opt_node;
  3588.         set_span(node,&curtok->ptr.token->loc);
  3589.  
  3590.         /* [expanded_name] ::= expanded_name */
  3591.         /* case 372 : */
  3592.  
  3593.  
  3594.         break;
  3595.         /* [WHEN__condition] ::= empty */
  3596.     case 373 :
  3597.         node = opt_node;
  3598.         set_span(node,&curtok->ptr.token->loc);
  3599.  
  3600.         break;
  3601.         /* [WHEN__condition] ::= WHEN condition */
  3602.     case 374 :
  3603.         node = AST(1);
  3604.  
  3605.  
  3606.         break;
  3607.         /* [expression] ::= empty */
  3608.     case 375 :
  3609.         node = opt_node;
  3610.         set_span(node,&curtok->ptr.token->loc);
  3611.  
  3612.         /* [expression] ::= expression */
  3613.         /* case 376 : */
  3614.  
  3615.  
  3616.         break;
  3617.         /* [formal_part] ::= empty */
  3618.     case 377 :
  3619.         node = opt_node;
  3620.         set_span(node,&curtok->ptr.token->loc);
  3621.  
  3622.         /* [formal_part] ::= formal_part */
  3623.         /* case 378 : */
  3624.  
  3625.  
  3626.         break;
  3627.         /* {;parameter_specification} ::= empty */
  3628.     case 379 :
  3629.         NN(AS_LIST);
  3630.         node->links.list = NULL;
  3631.         set_span(node,&curtok->ptr.token->loc);
  3632.  
  3633.         break;
  3634.         /* {;parameter_specification} ::=
  3635.             {;parameter_specification} ; parameter_spe */
  3636.     case 380 :
  3637. #define parm_spec AST(2)
  3638.         node = AST(0);
  3639.         append(node,parm_spec);
  3640. #undef parm_spec
  3641.  
  3642.         break;
  3643.         /* [IN] ::= empty */
  3644.     case 381 :
  3645.         NN(AS_MODE);
  3646.         node->links.val = namemap("",0);
  3647.         set_span(node,&curtok->ptr.token->loc);
  3648.  
  3649.         break;
  3650.         /* [IN] ::= IN */
  3651.     case 382 :
  3652.         NN(AS_MODE);
  3653.         node->links.val = namemap("in",2);
  3654.         set_span(node,LOC(0));
  3655.  
  3656.  
  3657.         break;
  3658.         /* [designator] ::= empty */
  3659.     case 383 :
  3660.         node = opt_node;
  3661.         set_span(node,&curtok->ptr.token->loc);
  3662.  
  3663.         /* [designator] ::= designator */
  3664.         /* case 384 : */
  3665.  
  3666.  
  3667.         break;
  3668.         /* [PRIVATE{basic_declarative_item}] ::= empty */
  3669.     case 385 :
  3670.         node = opt_node;
  3671.         set_span(node,&curtok->ptr.token->loc);
  3672.  
  3673.         break;
  3674.         /* [PRIVATE{basic_declarative_item}] ::=
  3675.             PRIVATE {basic_declarative_item} */
  3676.     case 386 :
  3677.         node = AST(1);
  3678.         LLOOPTOP(node->links.list,tmp)
  3679.             if (isbody_node[tmp->val.node->kind])
  3680.                 syntax_err(SPAN(tmp->val.node),
  3681.      "Body declaration not allowed in private part of package_specification");
  3682.         LLOOPBOTTOM(tmp)
  3683.         node->kind = AS_DECLARATIONS;
  3684.         ins_as_line_no(node);
  3685.  
  3686.  
  3687.         break;
  3688.         /* [LIMITED] ::= empty */
  3689.     case 387 :
  3690.         node = opt_node;
  3691.         set_span(node,&curtok->ptr.token->loc);
  3692.  
  3693.         break;
  3694.         /* [LIMITED] ::= LIMITED */
  3695.     case 388 :
  3696.         node = any_node;
  3697.         set_span(node,LOC(0));
  3698.  
  3699.  
  3700.         break;
  3701.         /* {,package_name} ::= empty */
  3702.     case 389 :
  3703.         NN(AS_LIST);
  3704.         node->links.list = NULL;
  3705.         set_span(node,&curtok->ptr.token->loc);
  3706.  
  3707.         break;
  3708.         /* {,package_name} ::= {,package_name} , package_name */
  3709.     case 390 :
  3710. #define pack_name AST(2)
  3711.         node = AST(0);
  3712.         append(node,pack_name);
  3713. #undef pack_name
  3714.  
  3715.         break;
  3716.         /* identifier:type_mark ::= identifier_list : type_mark */
  3717.     case 391 :
  3718. #define id_list_node AST(0)
  3719. #define type_mark AST(2)
  3720.         {
  3721.             struct two_pool *tmp;
  3722.  
  3723.             tmp = id_list_node->links.list->link;
  3724.             id_node = tmp->val.node;
  3725.             if (tmp != id_list_node->links.list) {
  3726.                 syntax_err(get_left_span(id_list_node),
  3727.                   get_right_span(type_mark),
  3728.                   "Only one identifier is allowed in this context");
  3729.                 id_list_node->links.list->link = tmp->link;
  3730.             }
  3731.             else
  3732.                 id_list_node->links.list = NULL;
  3733.             TFREE(tmp,tmp);
  3734.             free_everything(id_list_node);
  3735.             NN(AS_RENAME_OBJ);
  3736.             NAST3(id_node,type_mark,any_node);
  3737.         }
  3738. #undef id_list_node
  3739. #undef type_mark
  3740.  
  3741.         break;
  3742.         /* identifier:EXCEPTION ::= identifier_list : EXCEPTION */
  3743.     case 392 :
  3744. #define id_list_node AST(0)
  3745.         {
  3746.             struct two_pool *tmp;
  3747.  
  3748.             tmp = id_list_node->links.list->link;
  3749.             id_node = tmp->val.node;
  3750.             if (tmp != id_list_node->links.list) {
  3751.                 syntax_err(get_left_span(id_list_node),END_LOC(2),
  3752.                   "Only one identifier is allowed in this context");
  3753.                 id_list_node->links.list->link = tmp->link;
  3754.             }
  3755.             else
  3756.                 id_list_node->links.list = NULL;
  3757.             TFREE(tmp,tmp);
  3758.             free_everything(id_list_node);
  3759.             NN(AS_RENAME_EX);
  3760.             NAST2(id_node,any_node);
  3761.         }
  3762. #undef id_list_node
  3763.  
  3764.  
  3765.         break;
  3766.         /* [TYPE] ::= empty */
  3767.     case 393 :
  3768.         node = opt_node;
  3769.         set_span(node,&curtok->ptr.token->loc);
  3770.  
  3771.         break;
  3772.         /* [TYPE] ::= TYPE */
  3773.     case 394 :
  3774.         node = any_node;
  3775.  
  3776.         break;
  3777.         /* {entry_declaration} ::= {pragma} */
  3778.     case 395 :
  3779.         node = AST(0);
  3780.         check_pragmas(node,task_pragmas);
  3781.  
  3782.         break;
  3783.         /* {entry_declaration} ::=
  3784.             {entry_declaration} entry_declaration {pragma} */
  3785.     case 396 :
  3786. #define entry_decl AST(1)
  3787. #define pragma_node AST(2)
  3788.         node = AST(0);
  3789.         check_pragmas(pragma_node,task_pragmas);
  3790.         node->links.list = concatl3(node->links.list,initlist(entry_decl),
  3791.           pragma_node->links.list);
  3792.         nodefree(pragma_node);
  3793. #undef entry_decl
  3794. #undef pragma_node
  3795.  
  3796.  
  3797.         break;
  3798.         /* {representation_clause} ::= empty */
  3799.     case 397 :
  3800.         NN(AS_LIST);
  3801.         node->links.list = NULL;
  3802.         set_span(node,&curtok->ptr.token->loc);
  3803.  
  3804.         break;
  3805.         /* {representation_clause} ::=
  3806.             {representation_clause} representation_clause */
  3807.     case 398 :
  3808. #define repr_clause AST(1)
  3809. #define pragma_node AST(2)
  3810.         node = AST(0);
  3811.         check_pragmas(pragma_node,task_repr_pragmas);
  3812.         node->links.list = concatl3(node->links.list,initlist(repr_clause),
  3813.           pragma_node->links.list);
  3814.         nodefree(pragma_node);
  3815. #undef repr_clause
  3816. #undef pragma_node
  3817.  
  3818.         break;
  3819.         /* [(discrete_range)][formal_part] ::= [formal_part] */
  3820.     case 399 :
  3821. #define formal_part AST(0)
  3822.         NN(AS_ENTRY);
  3823.         NAST2(any_node,formal_part);
  3824.         set_span(any_node,get_left_span(formal_part)); /* kludge for errors */
  3825. #undef formal_part
  3826.  
  3827.         break;
  3828.         /* [(discrete_range)][formal_part] ::= (discrete_range) [formal_part] */
  3829.     case 400 :
  3830. #define discrete_range AST(1)
  3831. #define formal_part AST(3)
  3832.         check_discrete_range(discrete_range);
  3833.         NN(AS_ENTRY_FAMILY);
  3834.         NAST3(any_node,discrete_range,formal_part);
  3835. #undef discrete_range
  3836. #undef formal_part
  3837.  
  3838.         break;
  3839.         /* [(entry_index)][formal_part] ::= [formal_part] */
  3840.     case 401 :
  3841. #define formal_part AST(0)
  3842.         NN(AS_ACCEPT);
  3843.         NAST4(any_node,opt_node,formal_part,any_node);
  3844. #undef formal_part
  3845.  
  3846.         break;
  3847.         /* [(entry_index)][formal_part] ::= ( entry_index ) [formal_part] */
  3848.     case 402 :
  3849. #define entry_index AST(1)
  3850. #define formal_part AST(3)
  3851.         NN(AS_ACCEPT);
  3852.         NAST4(any_node,entry_index,formal_part,any_node);
  3853. #undef entry_index
  3854. #undef formal_part
  3855.  
  3856.  
  3857.         break;
  3858.         /* {OR__select_alternative} ::= empty */
  3859.     case 403 :
  3860.         NN(AS_LIST);
  3861.         node->links.list = NULL;
  3862.         set_span(node,&curtok->ptr.token->loc);
  3863.  
  3864.         break;
  3865.         /* {OR__select_alternative} ::=
  3866.             {OR__select_alternative} OR {pragma} select_ */
  3867.     case 404 :
  3868. #define pragma_node AST(2)
  3869. #define alt AST(3)
  3870.         node = AST(0);
  3871.         check_pragmas(pragma_node,null_pragmas);
  3872.         node->links.list = concatl3(node->links.list,pragma_node->links.list,
  3873.           initlist(alt));
  3874.         nodefree(pragma_node);
  3875. #undef pragma_node
  3876. #undef alt
  3877.  
  3878.  
  3879.         break;
  3880.         /* [WHEN__condition=>] ::= empty */
  3881.     case 405 :
  3882.         node = opt_node;
  3883.         set_span(node,&curtok->ptr.token->loc);
  3884.  
  3885.         break;
  3886.         /* [WHEN__condition=>] ::= WHEN condition => {pragma} */
  3887.     case 406 :
  3888. #define pragma_node AST(3)
  3889.         node = AST(1);
  3890.         check_pragmas(pragma_node,null_pragmas);
  3891.         pragmalist_warning(pragma_node);
  3892.         free_everything(pragma_node);
  3893. #undef pragma_node
  3894.  
  3895.         break;
  3896.         /* [sequence_of_statements] ::= {pragma} */
  3897.     case 407 :
  3898. #define pragma_node AST(0)
  3899.         check_pragmas(pragma_node,null_pragmas);
  3900.         if (pragma_node->links.list != NULL) {
  3901.             struct ast *label_list_node;
  3902.  
  3903.             NN(AS_STATEMENTS);
  3904.             label_list_node = new_node(AS_LIST);
  3905.             label_list_node->links.list = NULL;
  3906.             set_span(label_list_node,&curtok->ptr.token->loc);
  3907.             NAST2(pragma_node,label_list_node);
  3908.         }
  3909.         else
  3910.             node = opt_node;
  3911.         set_span(node,&curtok->ptr.token->loc);
  3912. #undef pragma_node
  3913.  
  3914.         /* [sequence_of_statements] ::= sequence_of_statements */
  3915.         /* case 408 : */
  3916.  
  3917.  
  3918.         break;
  3919.         /* {,task_name} ::= empty */
  3920.     case 409 :
  3921.         NN(AS_LIST);
  3922.         node->links.list = NULL;
  3923.         set_span(node,&curtok->ptr.token->loc);
  3924.  
  3925.         break;
  3926.         /* {,task_name} ::= {,task_name} , task_name */
  3927.     case 410 :
  3928. #define task_name AST(2)
  3929.         node = AST(0);
  3930.         append(node,task_name);
  3931. #undef task_name
  3932.  
  3933.         break;
  3934.         /* {compilation_unit} ::= {pragma} */
  3935.     case 411 :
  3936. #define pragma_node AST(0)
  3937.         check_pragmas(pragma_node,compilation_pragmas);
  3938.         TBSL;
  3939.         if (astopt)
  3940.             print_tree(pragma_node);
  3941.         if (curtok->symbol != EOFT_SYM) {
  3942.             free_everything(pragma_node);
  3943.             free_labels();
  3944.         }
  3945.         prs_stack->symbol = lhs[red];
  3946.         return;
  3947. #undef pragma_node
  3948.  
  3949.         /* {compilation_unit} ::= {compilation_unit} compilation_unit {pragma}*/
  3950.     case 412 :
  3951. #define comp_unit AST(1)
  3952. #define pragma_node AST(2)
  3953.         {
  3954.             node = AST(0);
  3955.             check_pragmas(pragma_node,after_libunit_pragmas);
  3956.             pragmalist_warning(pragma_node);
  3957.             TBSL;
  3958.             if (astopt) {
  3959.                 print_tree(comp_unit);
  3960.                 /*        print_tree(pragma_node); */
  3961.             }
  3962.             if (curtok->symbol != EOFT_SYM)
  3963.             {
  3964.                 free_everything(comp_unit);
  3965.                 free_everything(pragma_node);
  3966.                 free_labels();
  3967.             }
  3968.         }
  3969. #undef comp_unit
  3970. #undef pragma_node
  3971.  
  3972.  
  3973.         break;
  3974.         /* {with_clause{use_clause}} ::= empty */
  3975.     case 413 :
  3976.         NN(AS_LIST);
  3977.         node->links.list = NULL;
  3978.         set_span(node,&curtok->ptr.token->loc);
  3979.  
  3980.         break;
  3981.         /* {with_clause{use_clause}} ::=
  3982.             {with_clause{use_clause}} with_clause use_c */
  3983.     case 414 :
  3984. #define with_clause AST(1)
  3985. #define use_clause_node AST(2)
  3986.         node = AST(0);
  3987.         use_clause_node->kind = AS_WITH_USE_LIST;
  3988.         prepend(with_clause,use_clause_node);
  3989.         append(node,use_clause_node);
  3990. #undef with_clause
  3991. #undef use_clause_node
  3992.  
  3993.         break;
  3994.         /* use_clause_list ::= {pragma} */
  3995.     case 415 :
  3996.         node = AST(0);
  3997.         check_pragmas(node,context_pragmas);
  3998.  
  3999.         break;
  4000.         /* use_clause_list ::= use_clause_list use_clause {pragma} */
  4001.     case 416 :
  4002. #define use_clause AST(1)
  4003. #define pragma_node AST(2)
  4004.         node = AST(0);
  4005.         check_pragmas(pragma_node,context_pragmas);
  4006.         node->links.list = concatl3(node->links.list,initlist(use_clause),
  4007.           pragma_node->links.list);
  4008.         nodefree(pragma_node);
  4009. #undef use_clause
  4010. #undef pragma_node
  4011.  
  4012.  
  4013.         break;
  4014.         /* {,unit_simple_name} ::= empty */
  4015.     case 417 :
  4016.         NN(AS_LIST);
  4017.         node->links.list = NULL;
  4018.         set_span(node,&curtok->ptr.token->loc);
  4019.  
  4020.         break;
  4021.         /* {,unit_simple_name} ::= {,unit_simple_name} , unit_simple_name */
  4022.     case 418 :
  4023. #define simple_name AST(2)
  4024.         node = AST(0);
  4025.         append(node,simple_name);
  4026. #undef simple_name
  4027.  
  4028.  
  4029.         break;
  4030.         /* {|exception_choice} ::= empty */
  4031.     case 419 :
  4032.         NN(AS_LIST);
  4033.         node->links.list = NULL;
  4034.         set_span(node,&curtok->ptr.token->loc);
  4035.  
  4036.         break;
  4037.         /* {|exception_choice} ::= {|exception_choice} '|' exception_choice */
  4038.     case 420 :
  4039. #define choice AST(2)
  4040.         node = AST(0);
  4041.         append(node,choice);
  4042. #undef choice
  4043.  
  4044.  
  4045.         break;
  4046.         /* {generic_parameter_declaration} ::= empty */
  4047.     case 421 :
  4048.         NN(AS_LIST);
  4049.         node->links.list = NULL;
  4050.         set_span(node,&curtok->ptr.token->loc);
  4051.  
  4052.         break;
  4053.         /* {generic_parameter_declaration} ::=
  4054.             {generic_parameter_declaration} gener */
  4055.     case 422 :
  4056. #define parm_decl AST(1)
  4057.         node = AST(0);
  4058.         append(node,parm_decl);
  4059. #undef parm_decl
  4060.  
  4061.         /* [IN[OUT]] ::= [IN] */
  4062.         /* case 423 : */
  4063.  
  4064.         break;
  4065.         /* [IN[OUT]] ::= IN OUT */
  4066.     case 424 :
  4067.         NN(AS_MODE);
  4068.         node->links.val = namemap("inout",5);
  4069.         set_span(node,LOC(0));
  4070.  
  4071.  
  4072.         break;
  4073.         /* [IS__name__or__<>] ::= empty */
  4074.     case 425 :
  4075.         node = opt_node;
  4076.         set_span(node,&curtok->ptr.token->loc);
  4077.  
  4078.         break;
  4079.         /* [IS__name__or__<>] ::= IS name */
  4080.     case 426 :
  4081.         node = AST(1);
  4082.  
  4083.         break;
  4084.         /* [IS__name__or__<>] ::= IS <> */
  4085.     case 427 :
  4086.         NN(AS_SIMPLE_NAME);
  4087.         node->links.val = namemap("box",3);
  4088.         set_span(node,LOC(1));
  4089.  
  4090.  
  4091.         break;
  4092.         /* [generic_actual_part] ::= empty */
  4093.     case 428 :
  4094.         node = opt_node;
  4095.         set_span(node,&curtok->ptr.token->loc);
  4096.  
  4097.         /* [generic_actual_part] ::= generic_actual_part */
  4098.         /* case 429 : */
  4099.  
  4100.  
  4101.         break;
  4102.         /* {,generic_association} ::= empty */
  4103.     case 430 :
  4104.         NN(AS_LIST);
  4105.         node->links.list = NULL;
  4106.         set_span(node,&curtok->ptr.token->loc);
  4107.  
  4108.         break;
  4109.         /* {,generic_association} ::=
  4110.             {,generic_association} , generic_association */
  4111.     case 431 :
  4112. #define assoc AST(2)
  4113.         node = AST(0);
  4114.         append(node,assoc);
  4115. #undef assoc
  4116.  
  4117.         break;
  4118.         /* [generic_formal_parameter=>]generic_actual_parameter ::=
  4119.             generic_actual_p */
  4120.     case 432 :
  4121. #define actual AST(0)
  4122.         NN(AS_INSTANCE);
  4123.         NAST2(opt_node,actual);
  4124. #undef actual
  4125.  
  4126.         break;
  4127.         /* [generic_formal_parameter=>]generic_actual_parameter ::=
  4128.             generic_formal_p */
  4129.     case 433 :
  4130. #define formal AST(0)
  4131. #define actual AST(2)
  4132.         NN(AS_INSTANCE);
  4133.         NAST2(formal,actual);
  4134. #undef formal
  4135. #undef actual
  4136.  
  4137.         break;
  4138.         /* [alignment_clause] ::= {pragma} */
  4139.     case 434 :
  4140. #define pragma_node AST(0)
  4141.         check_pragmas(pragma_node,null_pragmas);
  4142.         pragmalist_warning(pragma_node);
  4143.         node = opt_node;
  4144.         set_span(node,&curtok->ptr.token->loc);
  4145.         free_everything(pragma_node);
  4146. #undef pragma_node
  4147.  
  4148.         break;
  4149.         /* [alignment_clause] ::= {pragma} alignment_clause {pragma} */
  4150.     case 435 :
  4151. #define pragma_node1 AST(0)
  4152. #define pragma_node2 AST(2)
  4153.         node = AST(1);
  4154.         check_pragmas(pragma_node1,null_pragmas);
  4155.         check_pragmas(pragma_node2,null_pragmas);
  4156.         pragmalist_warning(pragma_node1);
  4157.         pragmalist_warning(pragma_node2);
  4158.         free_everything(pragma_node1);
  4159.         free_everything(pragma_node2);
  4160. #undef pragma_node1
  4161. #undef pramga_node2
  4162.  
  4163.  
  4164.         break;
  4165.         /* {component_clause} ::= empty */
  4166.     case 436 :
  4167.         NN(AS_LIST);
  4168.         node->links.list = NULL;
  4169.         set_span(node,&curtok->ptr.token->loc);
  4170.  
  4171.         break;
  4172.         /* {component_clause} ::= {component_clause} component_clause {pragma}*/
  4173.     case 437 :
  4174. #define compon_clause AST(1)
  4175. #define pragma_node AST(2)
  4176.         node = AST(0);
  4177.         check_pragmas(pragma_node,null_pragmas);
  4178.         pragmalist_warning(pragma_node);
  4179.         append(node,compon_clause);
  4180.         free_everything(pragma_node);
  4181. #undef compon_clause
  4182. #undef pragma_node
  4183.         break;
  4184.     default :
  4185.         prs_stack->symbol = lhs[red];
  4186.         return;
  4187.     }
  4188.     prs_stack->symbol = lhs[red];
  4189.     prs_stack->ptr.ast = node;
  4190.     for (n = rhslen[red]; n--;)
  4191.         if (ISTOKEN(rh[n]))
  4192.             TOKFREE(rh[n]->ptr.token);
  4193. }
  4194.  
  4195.  
  4196.